来自包含数组的活动单元格的 VBA Excel 超链接列表答案

【问题标题】：VBA Excel List of Hyperlinks from activecell containing Array来自包含数组的活动单元格的 VBA Excel 超链接列表
【发布时间】：2014-02-26 23:34:02
【问题描述】：

这有点模糊，因为我真的不知道从哪里开始。

我有一个看起来像这样的动态数据库输出：

Link1
Link2
Link3,Link4,Link5
Link6
Link7,Link8

每个链接代表我的电子表格中的其他位置。我有 VBA 代码可以运行并根据单元格值生成超链接，但显然这不适用于包含多个链接的单元格。

我的想法是，当活动单元格包含“，”时，我在后台有一个用户表单。

我需要做的是从 Active Cell 创建一个数组：

arr = Split(ActiveCell.Value, ",")

然后让它填充一个表单，然后可以对其进行编程以使用后续列表作为超链接。

抱歉，我没有在这方面做更多的基础工作。我正在努力寻找任何现有的相关信息。

这里的关键问题是：

哪个用户窗体最适合使用？（组合框/列表框？）
如何根据活动单元格的内容使表单可见。
如何将活动单元格的内容放入表单中。
如何将表单中的项目链接到单元格引用。（对此请注意，每个“Linkx”都应链接到电子表格中某个包含完全相同值的另一个单元格）。

非常感谢您的任何建议。大卫

更新：

我想出了以下创建列表的方法：

Option Explicit
Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Cancel = True
Dim arr As Variant
Dim arrin As Variant
Dim ArrLen As Integer
Dim i As Integer

If InStr(1, ActiveCell.Value, ",", vbTextCompare) <> 0 Then
    If InStr(1, ActiveCell.Value, "|", vbTextCompare) <> 0 Then
        ListBoxDictionary.RemoveAll
        arr = Split(ActiveCell.Value, ",")
        ArrLen = Application.CountA(arr)
        If UserForm1.Visible = True Then
            UserForm1.ListBox1.Clear
        End If
        For i = 0 To ArrLen - 1
            arrin = Split(arr(i), "|")
            UserForm1.ListBox1.AddItem arrin(1) & " - " & Left(arrin(0), InStr(1, arrin(0), "]"))
            ListBoxDictionary(arrin(1) & " - " & Left(arrin(0), InStr(1, arrin(0), "]"))) = arrin(0)
        Next i

        If UserForm1.Visible = False Then
            UserForm1.Show
            UserForm1.Caption = Cells(1, ActiveCell.Column).Value
        End If
    End If
End If


End Sub

我现在需要确定一种使用“选定项目”在我的工作簿中查找匹配单元格的方法。此匹配单元格可能位于所有可见工作表上“D”列的已用单元格中。

更新 2：

对于遇到类似问题的任何人，这是我的解决方案：

Global ListBoxDictionary As New Dictionary
Public Sub ListBox1_Click()
    Dim WS_Count As Integer
    Dim WS_No
    Dim Fnd As Integer
    Dim LstItem As String

    WS_Count = ActiveWorkbook.Worksheets.Count
    Fnd = 0
    LstItem = ListBoxDictionary.Item(ListBox1.Value)

    For WS_No = 1 To WS_Count
        If Fnd <> 1 Then
            If Sheets(WS_No).Name <> "Sheet2" Then
                c = Application.Match(LstItem, Sheets(WS_No).Range("D:D"), 0)
                If IsError(c) Then
                Else
                    Fnd = 1
                    UserForm1.Hide
                    Sheets(WS_No).Activate
                    Sheets(WS_No).Cells(c, "D").Activate
                    UserForm1.ListBox1.Clear
                End If
            End If
        End If
    Next WS_No
End Sub

使用字典的原因是因为我希望能够更改链接中显示的文本，同时保留我需要使用的搜索字符串。

感谢您的意见。大卫

【问题讨论】：

您可以将表单列表框添加到工作表。使用工作表的 Selection-Change 事件检查选择了哪些单元格：如果它是“链接”单元格之一，则拆分内容并使用值填充列表。

标签： vba excel hyperlink

【解决方案1】：

将名为“lstLinks”的表单列表框添加到工作表并将其“宏”设置为PickedOne。从您的问题中不清楚您实际上是如何导航到“链接”范围的。

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Worksheet_BeforeDoubleClick Target, False
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lst As Object, arr, x
Dim lstObj As Object

    Set Target = Target.Cells(1) 'ignore multi-cell selections
    Set lst = Me.Shapes("lstLinks")

    If InStr(Target.Value, ",") > 0 Then
        lst.Visible = True
        lst.Top = Target.Top + Target.RowHeight
        lst.Left = Target.Left
        arr = Split(Target.Value, ",")
        Set lstObj = lst.OLEFormat.Object
        Do While lstObj.ListCount > 0
            lstObj.RemoveItem 1
        Loop
        For x = LBound(arr) To UBound(arr)
            lstObj.AddItem Trim(arr(x))
        Next x
        Cancel = True
    Else
        lst.Visible = False
    End If
End Sub

Sub PickedOne()
    Dim lst, v
    Set lst = Me.Shapes(Application.Caller)
    v = lst.OLEFormat.Object.List(lst.OLEFormat.Object.ListIndex)
    lst.Visible = False
    ShowItem v
End Sub

Sub ShowItem(v)
    MsgBox "Showing item: " & v
End Sub

【讨论】：

嗨蒂姆，非常感谢您的回复。我已尝试测试您的建议，但出现以下编译错误：{Invalid Use of Me 关键字}
代码进入工作表代码模块，而不是常规模块。右键单击工作表选项卡并选择“查看代码”

【解决方案2】：

以下从逗号分隔的字符串创建列表并将其放入：

（请注意，我的链接列表现在已演变为：

Link1|Description
Link2|Description,Link3|Description
Link4|Description

等等）

Option Explicit
Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Cancel = True
Dim arr As Variant
Dim arrin As Variant
Dim ArrLen As Integer
Dim i As Integer

If InStr(1, ActiveCell.Value, ",", vbTextCompare) <> 0 Then
    If InStr(1, ActiveCell.Value, "|", vbTextCompare) <> 0 Then
        ListBoxDictionary.RemoveAll
        arr = Split(ActiveCell.Value, ",")
        ArrLen = Application.CountA(arr)
        If UserForm1.Visible = True Then
            UserForm1.ListBox1.Clear
        End If
        For i = 0 To ArrLen - 1
            arrin = Split(arr(i), "|")
            UserForm1.ListBox1.AddItem arrin(1) & " - " & Left(arrin(0), InStr(1, arrin(0), "]"))
            ListBoxDictionary(arrin(1) & " - " & Left(arrin(0), InStr(1, arrin(0), "]"))) = arrin(0)
        Next i

        If UserForm1.Visible = False Then
            UserForm1.Show
            UserForm1.Caption = Cells(1, ActiveCell.Column).Value
        End If
    End If
End If


End Sub

除了上述之外，这是用于超链接的列表框本身的代码：

Global ListBoxDictionary As New Dictionary
Public Sub ListBox1_Click()
    Dim WS_Count As Integer
    Dim WS_No
    Dim Fnd As Integer
    Dim LstItem As String

    WS_Count = ActiveWorkbook.Worksheets.Count
    Fnd = 0
    LstItem = ListBoxDictionary.Item(ListBox1.Value)

    For WS_No = 1 To WS_Count
        If Fnd <> 1 Then
            If Sheets(WS_No).Name <> "Sheet2" Then
                c = Application.Match(LstItem, Sheets(WS_No).Range("D:D"), 0)
                If IsError(c) Then
                Else
                    Fnd = 1
                    UserForm1.Hide
                    Sheets(WS_No).Activate
                    Sheets(WS_No).Cells(c, "D").Activate
                    UserForm1.ListBox1.Clear
                End If
            End If
        End If
    Next WS_No
End Sub

使用字典的原因是因为我希望能够更改链接中显示的文本，同时保留我需要使用的搜索字符串。

从上面看，这是我能想到的最佳答案。

感谢其他建议。大卫。

【讨论】：