使用文本字符串将单元格（在多列中）链接到同一工作簿中具有相同名称的工作表

Question

我在名为“目录”的工作表中的 B、D、F、H、J 列中有单元格，我想遍历整个列中的单元格以在工作簿中查找具有相同名称/文本的工作表字符串和超链接到 A1。下面是我当前的代码，但是如果另一组文本之前有一系列空单元格，它就会停止。我希望它贯穿我列出的整个列范围。

Sub CreateHyperLinks()
    Dim wsMaster As Worksheet, ws As Worksheet, m, c As Range
    Dim wb As Workbook
    
    Set wb = ThisWorkbook
    Set wsMaster = wb.Worksheets("Table of Contents")
    
    For Each ws In wb.Worksheets
        If ws.Name <> wsMaster.Name And ws.Name <> "Table of Contents" Then
            m = Application.Match(ws.Name, wsMaster.Range("B:J"), 0)
                Set c = wsMaster.Cells(m, "B:J")
                DoLink c, ws.Range("a1")
                DoLink ws.Range("a1"), wsMaster.Range("A1"), _
                       "Back to " & wsMaster.Name
            End If
        End If
    Next ws
   
End Sub

Sub DoLink(FromCell As Range, ToCell As Range, Optional LinkText As String = "")
    FromCell.Worksheet.Hyperlinks.Add Anchor:=FromCell, Address:="", _
    SubAddress:="'" & ToCell.Worksheet.Name & "'!" & ToCell.Address(False, False), _
    TextToDisplay:=IIf(Len(LinkText) > 0, LinkText, FromCell.Text)
End Sub

Answer 1

如果您想搜索多列，则需要使用

Find()

：

Sub CreateHyperLinks()
    Dim wsMaster As Worksheet, ws As Worksheet, m, c As Range
    Dim wb As Workbook, f As Range
    
    Set wb = ThisWorkbook
    Set wsMaster = wb.Worksheets("Table of Contents")
    
    For Each ws In wb.Worksheets
        If ws.Name <> wsMaster.Name And ws.Name <> "Table of Contents" Then
            Set f = wsMaster.Range("B:J").Find(ws.Name, lookat:=xlWhole, MatchCase:=False)
            If Not f Is Nothing Then        'got a match?
                DoLink f, ws.Range("a1")
                DoLink ws.Range("a1"), wsMaster.Range("A1"), _
                       "Back to " & wsMaster.Name
            End If
        End If
    Next ws
End Sub

Sub DoLink(FromCell As Range, ToCell As Range, Optional LinkText As String = "")
    FromCell.Worksheet.Hyperlinks.Add Anchor:=FromCell, Address:="", _
        SubAddress:="'" & ToCell.Worksheet.Name & "'!" & ToCell.Address(False, False), _
        TextToDisplay:=IIf(Len(LinkText) > 0, LinkText, FromCell.text)
End Sub