Excel: найти соответствующую гиперссылку

Question

Потратив некоторое время на поиски ответа в сети без успеха, вот мой вопрос:

У меня есть две рабочие книги, назовем их «профили» и «результаты».

В «профилях» у меня есть лист с гиперссылками от A3 до A2000. В этих ячейках появляются имена, такие как «Джим», «Дейв», «Анна» и т.д. Гиперссылки, лежащие в основе, отличаются только идентификатором определенного имени, например, «www.destinationwebsite.com/nameID». nameID отличается в каждом случае.

В «результатах» у меня есть лист, и один экземпляр любого из этих имен / гиперссылок может появиться в любом месте от C3 до Cx.

На данный момент я просто делаю базовое сравнение между именами в двух книгах, и это работает, информируя меня, если имя в «профилях» находится в «результатах». Однако, если в результатах есть два или более «Джима» (с разными идентификаторами), это не сработает. Единственный способ обойти это - на самом деле проверить соответствие гиперссылок ('nameID'), чтобы убедиться, что я ссылаюсь на правильный 'Jim'.

Потратив некоторое время на это, я вынужден был признать поражение - конечно, сделать что-то столь простое должно быть легко в Excel.

Любая помощь будет оценена в преодолении этого камня преткновения.

Answer 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