Excel VBA 查找匹配后自动打开对应超链接功能实现咨询

核心改动：保留原有的触发条件、VLookup匹配逻辑，仅将消息弹窗替换为超链接打开操作，删除原代码中未使用的冗余变量，新增异常处理避免无效链接导致程序报错。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim linkPath As String

    ' 原有触发判断逻辑完全保留
    If Target.Column = 3 Then
        If Target.CountLarge > 1 Then Exit Sub
        If Target.Value = "" Then Exit Sub

        ' 原有VLookup匹配逻辑完全保留
        With Application
            linkPath = .IfError(.VLookup(Target.Text, Worksheets("Test").Columns("A:B"), 2, 0), "")
        End With

        ' 匹配成功则打开超链接
        If linkPath <> "" Then
            On Error Resume Next
            ' NewWindow参数设为True表示在新窗口打开链接，可根据需要改为False
            ThisWorkbook.FollowHyperlink Address:=linkPath, NewWindow:=True
            If Err.Number <> 0 Then
                MsgBox "链接打开失败，请确认Test表B列对应地址有效", vbExclamation, "操作提示"
            End If
            On Error GoTo 0
        End If
    End If
End Sub

如果Test表B列是通过「插入超链接」功能绑定的链接（单元格显示文本和实际链接地址不一致），可将VLookup部分替换为Find定位逻辑，直接读取单元格的超链接地址：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim matchRng As Range
    Dim linkPath As String

    If Target.Column = 3 Then
        If Target.CountLarge > 1 Then Exit Sub
        If Target.Value = "" Then Exit Sub

        ' 用Find方法定位匹配的单元格
        Set matchRng = Worksheets("Test").Columns("A:A").Find(What:=Target.Text, LookIn:=xlValues, LookAt:=xlWhole)
        If Not matchRng Is Nothing Then
            ' 读取对应B列单元格的超链接地址
            If matchRng.Offset(0, 1).Hyperlinks.Count > 0 Then
                linkPath = matchRng.Offset(0, 1).Hyperlinks(1).Address
                On Error Resume Next
                ThisWorkbook.FollowHyperlink Address:=linkPath, NewWindow:=True
                If Err.Number <> 0 Then
                    MsgBox "链接打开失败，请确认Test表B列对应地址有效", vbExclamation, "操作提示"
                End If
                On Error GoTo 0
            End If
        End If
    End If
End Sub

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