Excel: Temukan hyperlink yang cocok

Setelah menghabiskan waktu mencari di internet untuk jawaban tanpa hasil, inilah pertanyaan saya:

Saya memiliki dua buku kerja, sebut saja 'profil' dan 'hasil'.

Dalam 'profil', saya memiliki selembar yang memiliki hyperlink dalam A3 hingga A2000. Nama muncul di sel-sel ini, seperti 'Jim', 'Dave', 'Anne' dll. Hyperlink yang mendasari hanya berbeda dengan ID nama tertentu, seperti 'www.destinationwebsite.com/nameID'. nameID berbeda dalam setiap kasus.

Dalam 'hasil' saya memiliki selembar dan satu instance dari salah satu nama / hyperlink ini dapat muncul di mana saja di C3 ke Cx.

Saat ini saya hanya melakukan perbandingan dasar antara nama-nama di dua buku kerja, dan ini berfungsi memberitahu saya jika nama di 'profil' ada di 'hasil'. Namun, jika ada dua atau lebih 'Jim dalam' hasil '(dengan ID berbeda) maka itu tidak berfungsi. Satu-satunya cara untuk melakukannya adalah dengan benar-benar memeriksa hyperlink yang cocok ('nameID') untuk memastikan saya mereferensikan 'Jim' yang benar.

Setelah menghabiskan beberapa waktu untuk hal ini, saya harus mengakui kekalahan - pasti melakukan sesuatu yang sangat mendasar harus mudah dilakukan di Excel.

Bantuan apa pun akan dihargai untuk bisa melewati batu sandungan ini.

Ini seharusnya bekerja

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