Excel: Encontre um hiperlink correspondente

Question

Depois de passar algum tempo pesquisando na net por uma resposta sem sucesso, aqui vai a minha pergunta:

Eu tenho duas pastas de trabalho, vamos chamá-las de 'perfis' e 'resultados'.

Em 'profiles' eu tenho uma planilha que possui hyperlinks em A3 a A2000. Nomes aparecem nessas células, como 'Jim', 'Dave', 'Anne' etc. Os hiperlinks subjacentes diferem apenas pelo ID de um nome específico, como 'www.destinationwebsite.com/nameID'. nameID sendo diferente em todos os casos.

Em 'resultados' eu tenho uma planilha e uma única instância de qualquer um desses nomes / hiperlinks pode aparecer em qualquer lugar em C3 a Cx.

No momento, estou apenas fazendo uma comparação básica entre os nomes nas duas pastas de trabalho, e isso funciona me informando se o nome em 'profiles' está em 'results'. No entanto, deve haver dois ou mais 'Jim's em' resultados '(com IDs diferentes), então não funciona. A única maneira de resolver isso é verificar se há hiperlinks correspondentes ('nameID') para ter certeza de que estou referenciando o 'Jim' correto.

Depois de passar algum tempo nisso, tive que admitir a derrota - certamente fazer algo tão básico deve ser fácil de fazer no Excel.

Qualquer ajuda seria apreciada em superar este obstáculo.

    

Answer 1

Isso deve funcionar

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