☰

Excel：查找匹配的超链接

tag-icon • tag-icon microsoft-excel vba hyperlink
Excel：查找匹配的超链接

花了一些时间在网上寻找答案却没有成功之后，我的问题如下：

我有两本工作簿，我们称之为“配置文件”和“结果”。

在“个人资料”中，我有一张包含 A3 到 A2000 超链接的工作表。这些单元格中显示名称，例如“Jim”、“Dave”、“Anne”等。底层超链接仅在特定名称的 ID 上有所不同，例如“www.destinationwebsite.com/nameID”。nameID 在每种情况下都不同。

在“结果”中我有一张表，这些名称/超链接中的任何一个实例都可以出现在 C3 到 Cx 的任何位置。

目前，我只是对两个工作簿中的名称进行基本比较，如果“profiles”中的名称在“results”中，则此方法有效。但是，如果“results”中有两个或多个“Jim”（具有不同的 ID），则此方法无效。解决此问题的唯一方法是实际检查匹配的超链接（“nameID”），以确保我引用的是正确的“Jim”。

在花了一些时间之后，我不得不承认失败——在 Excel 中做一些如此基本的事情应该很容易。

如能得到任何帮助以帮助克服这个障碍，我们将不胜感激。

答案1

这应该有效

Sub CheckLinks()
Dim WBprofiles As Workbook
Set WBprofiles = ThisWorkbook
Dim WBresults As Workbook
Set WBresults = Workbooks.Open("C:\Users\path\to\results.xlsx")

Dim WSprofiles As Worksheet
Set WSprofiles = WBprofiles.Sheets("profiles")
Dim WSresults As Worksheet
Set WSresults = WBresults.Sheets("results")

Dim DictResults As Object
Set DictResults = CreateObject("Scripting.Dictionary")

Dim lastrow As Integer
lastrow = WSresults.Cells(Rows.Count, "A").End(xlUp).Row

Dim strKey As String
For d = 1 To lastrow
    strKey = Cells(d, 1).Hyperlinks(1).Address
    DictResults(strKey) = 1
Next

Dim vResult() As Variant
ReDim vResult(DictResults.Count - 1, 1)
Dim x As Integer

For Each Key In DictResults.keys
    vResult(x, 0) = Key
    x = x + 1
Next

lastrow = WSprofiles.Cells(Rows.Count, "A").End(xlUp).Row
Dim strLoc As String
Dim i As Integer
For Each link In WSprofiles.Range("A1:A" & lastrow).Hyperlinks
    strLoc = link.Address
    For i = LBound(vResult) To UBound(vResult)
        If vResult(i, 0) = strLoc Then
            link.Range.Offset(, 1) = "Found"
        End If
    Next
Next

End Sub

相关内容