Поиск частичного совпадения тестовых ячеек в ексель

Sub Comp_Url()
Dim dict As New Dictionary
    '::: Загрузка имен сайтов из колонки A в словарь
    iii% = 1
    Do
       aUrl$ = Trim$(Sheets(1).Cells(iii%, 1).Value)
       If Len(aUrl$) = 0 Then Exit Do
       Url$ = GetUrl(aUrl$)
       If Not dict.Exists(Url$) Then dict.Add Url$, CStr(iii%)
       iii% = iii% + 1
    Loop
    '::: Проверка второго столбца
    iii% = 1
    Do
       bUrl$ = Trim$(Sheets(1).Cells(iii%, 2).Value)
       If Len(bUrl$) = 0 Then Exit Do
       Url$ = GetUrl(bUrl$)
       If dict.Exists(Url) Then Sheets(1).Cells(iii%, 3) = "Есть в стр: " + dict.Item(Url)
       iii% = iii% + 1
    Loop
    MsgBox "OK!"
End Sub
 
Function GetUrl(Url As String)
   k% = InStr(8, Url, "/")
   If k% = 0 Then
      GetUrl = Url
   Else
      GetUrl = Left$(Url, k% - 1)
   End If
End Function