如何使用 VBA 在单元格和以这些单元格中的文本命名的工作表之间自动创建超链接？

Question

我试图弄清楚如何创建一个 VBA 代码，该代码可以运行以超链接列中的单元格，其中的工作表以这些单元格命名。我们正在建立维护日志，并在主表上列出所有机器。然后，我们创建表格来捕获每台设备的服务数据和其他信息。该工作簿非常大，因此我们希望将单元格与其各自的工作表进行超链接。我已经一一检查并链接它们，但如果我在试用阶段需要更新或重做日志，我不想再花时间了。

有没有办法在 VBA 中完成此操作？我们制作了模块来根据模板和新机器名称自动创建工作表，但将所有机器连接到其工作表需要大量细致的工作。

列数据位置

配套表

我的一位同事使用了这个，但它会遍历并重写工具编号列中的所有数据，使行中的所有数据与各自的工具编号不同步。我们只希望工具编号（B 列）超链接到与 B 列中的名称完全相同的工作表。

Sub CreateHyperLinks()
    Dim x As Worksheet
    Dim Counter As Integer
    Counter = 0
    For Each x In Worksheets
    Counter = Counter + 1
    If Counter = 1 Then GoTo Donothing
        With ActiveCell
            .Value = x.Name
            .Hyperlinks.Add ActiveCell, "", x.Name & "!A1", TextToDisplay:=x.Name, ScreenTip:="Click here to go to the Worksheet"
            With Worksheets(Counter)
                .Range("A1").Value = "Back to " & ActiveSheet.Name
                .Hyperlinks.Add Sheets(x.Name).Range("A1"), "", _
                "'" & ActiveSheet.Name & "'" & "!" & ActiveCell.Address, _
                ScreenTip:="Return to " & ActiveSheet.Name
            End With
        End With
    ActiveCell.Offset(1, 0).Select
Donothing:
Next x
End Sub

Answer 1

试试这个：

Sub CreateHyperLinks()
    Dim wsMaster As Worksheet, ws As Worksheet, m, c As Range
    Dim wb As Workbook
    
    Set wb = ThisWorkbook 'or active workbook
    Set wsMaster = wb.Worksheets("Master")
    
    For Each ws In wb.Worksheets
        'exclude any sheets you want to skip
        If ws.Name <> wsMaster.Name And ws.Name <> "Template" Then
            'look for matching value in ColB on master sheet
            m = Application.Match(ws.Name, wsMaster.Columns("B"), 0)
            If Not IsError(m) Then  'got a match?
                Set c = wsMaster.Cells(m, "B")
                'link to sheet
                wsMaster.Hyperlinks.Add Anchor:=c, Address:="", _
                                    SubAddress:="'" & ws.Name & "'!A1", _
                                    TextToDisplay:=c.Value
                'link back to Master sheet
                ws.Hyperlinks.Add Anchor:=ws.Range("A1"), Address:="", _
                                    SubAddress:="'" & wsMaster.Name & "'!A1", _
                                    TextToDisplay:="Back to " & wsMaster.Name
            
            End If
        End If
    Next ws
   
End Sub