VBA Excel ActiveList中包含數組的超鏈接列表

Question

這是一個稍微模糊的，因爲我真的不知道從哪裏開始。

我有一個動態的數據庫輸出看起來是這樣的：

Link1 
Link2 
Link3,Link4,Link5 
Link6 
Link7,Link8 

其中每一個環節代表別的地方我的電子表格。我有VBA代碼運行並基於單元格值生成超鏈接，但顯然這不適用於包含多個鏈接的單元格。

我的想法是讓我在背景中有一個用戶窗體，當活動單元格包含「，」時變爲可見。

我需要做的就是創建從活動單元格數組：

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

然後有填充，然後可以進行編程，以使用後續的列表作爲超鏈接的形式。

我很抱歉，我沒有在這方面做更多的基礎工作。我正在努力尋找任何現有的相關信息。

這裏的關鍵問題是：

• 哪個用戶窗體是最好用？ （ComboBox/ListBox？）
• 如何根據活動單元格的內容使表單可見。
• 如何獲取活動單元格的內容到表單中。
• 如何將表單中的項目鏈接到單元格引用。 （關於這一點，每個'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 

使用字典的原因是因爲我希望能夠改變文本在鏈接中顯示，同時保留我需要搜索的字符串。

感謝您的意見。 David

Answer 1

下面就來創建一個從逗號分隔的字符串列表，並把它放入：

（請注意，我的鏈接列表現在已經演變成：

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 

隨着以上，這是用於列表框本身爲hyperli代碼nking：

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 

使用一本字典，是因爲我希望能夠改變顯示的鏈接，同時保留我需要使用搜索的字符串文本的原因。

從上面，這是我能想出的最好的答案。

感謝您的其他建議。 David。

Answer 2

將名爲「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