关于2个工作表，相同的文本内容之间，批量生成超链接的请教

hezudao_long

示范图片和文件如下，望各位不吝赐教，不甚感激。

汉唐

请楼主参考附件

gwjkkkkk

Option Explicit
Sub TEST()
    Dim ar, i&, dic As Object
   
    Application.DisplayAlerts = False
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets(1)
        .Cells.Hyperlinks.Delete
        ar = .[A2].CurrentRegion
        For i = 2 To UBound(ar): dic(ar(i, 2)) = i: Next
    End With
    With Sheets(2)
        .Cells.Hyperlinks.Delete
        ar = .[D2].CurrentRegion
    End With
    With Sheets(2).[D2].CurrentRegion
        For i = 2 To UBound(ar)
            If dic.exists(ar(i, 2)) Then
                .Hyperlinks.Add .Cells(i, 2), "", Sheets(1).Name & "!B" & dic(ar(i, 2)) + 1, "单击打开：工作表A"
                Sheets(1).Hyperlinks.Add Sheets(1).Cells(dic(ar(i, 2)) + 1, 2), "", .Parent.Name & "!E" & i + 1, "单击打开：工作表B"
            End If
        Next i
    End With
   
    Application.DisplayAlerts = True
    Beep
End Sub

gwjkkkkk

请参考，，，

hezudao_long

感谢两位朋友的热心解答！