将目录工作表指定列单元格链接到同名工作表A1的VBA代码优化

原代码存在几个关键问题导致无法完成需求：

• 逻辑倒置：原代码是遍历工作簿中的工作表，再反向查找目录表中的匹配项，而非遍历目录表指定列的单元格来匹配工作表。
• 语法错误：Set c = wsMaster.Cells(m, "B:J") 中，Cells的列参数不能传入多列区域，无法准确定位匹配的单元格。
• 错误未捕获：当Match找不到匹配项时会触发运行时错误，直接中断代码执行。
• 未限定遍历范围：没有针对指定的B、D、F、H、J列单独遍历，而是在整个B:J区域查找，不符合需求。

修正后的代码 #

Sub CreateHyperLinks()
    Dim wsMaster As Worksheet, ws As Worksheet
    Dim targetCols As Variant, col As Variant
    Dim cell As Range, lastRow As Long
    
    Set wsMaster = ThisWorkbook.Worksheets("Table of Contents")
    ' 指定需要遍历的列：B、D、F、H、J
    targetCols = Array("B", "D", "F", "H", "J")
    
    ' 先为所有非目录工作表添加返回链接
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> wsMaster.Name Then
            ' 清除原有返回链接，避免重复添加
            On Error Resume Next
            ws.Range("A1").Hyperlinks.Delete
            On Error GoTo 0
            ' 添加返回目录的链接
            DoLink ws.Range("A1"), wsMaster.Range("A1"), "Back to " & wsMaster.Name
        End If
    Next ws
    
    ' 遍历指定列的每个非空单元格，添加对应工作表的超链接
    For Each col In targetCols
        lastRow = wsMaster.Cells(wsMaster.Rows.Count, col).End(xlUp).Row
        ' 遍历该列从第1行到最后一行的单元格
        For Each cell In wsMaster.Range(wsMaster.Cells(1, col), wsMaster.Cells(lastRow, col))
            ' 单元格非空且存在同名工作表时添加链接
            If cell.Value <> "" Then
                On Error Resume Next
                Set ws = ThisWorkbook.Worksheets(cell.Value)
                On Error GoTo 0
                If Not ws Is Nothing Then
                    ' 清除原有链接，避免重复
                    cell.Hyperlinks.Delete
                    DoLink cell, ws.Range("A1")
                    Set ws = Nothing ' 释放对象
                End If
            End If
        Next cell
    Next col
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

修正说明 #

1. 明确遍历范围：用Array("B", "D", "F", "H", "J")指定目标列，逐个遍历每一列的非空单元格。
2. 错误处理：添加On Error Resume Next捕获工作表不存在的情况，避免代码中断。
3. 逻辑修正：先遍历工作表添加返回链接，再遍历目录表指定列的单元格，匹配同名工作表后添加超链接。
4. 避免重复链接：添加超链接前先清除单元格原有超链接，防止重复添加导致的混乱。

内容的提问来源于stack exchange，提问作者Michael Mesa