Excel VBA-адрес, сравнивающий выходные не совпадающие адреса

Question

Я работаю над книгой с тремя вкладками.Мой список клиентов Адреса, Аутсорсинг, список адресов клиентов: и Вывод не совпадают :.Я пытаюсь запустить мои списочные агенты в списке аутсорсинга, и если мой список адресов не совпадает ни с одним из адресов в списке внешних источников.Выводится на вкладке Нет совпадения.

Я создал рабочий документ, но он очень медленный, и я чувствую, что кто-то здесь действительно может помочь мне указать верное направление.

Заголовки столбцов всех трех листов («Имя клиента», «Адрес 1», «Адрес 2», «Город», «Штат», «Почтовый индекс»)

Я используюкод, подобный приведенному ниже, чтобы найти ни одного совпадения во всех столбцах.Он только смотрит на первые несколько символов в надежде ускорить процесс, но я не так быстро.

Я запускаю его в цикле, примерно так, который кажется очень непрерывным и медленным при сравнении адресов агента200 000 записей.

For I = 2 To LastRow

If Left(UCase(Trim(wsAddressS_1.Cells(1 + I, 6).Value)), 5) = 
Left(UCase(VLookLike(wsAddressS_1.Cells(1 + I, 6).Value, wsAddressS_2.Range("F1:F" & LastRow2 + 10))), 5) Then
    Match_Zip = "Match"
Else
    Match_Zip = "No Match"
End If

If strMatchZip <> "Match" Then

            LastRow1 = wsAddressS_4.Range("F" & Rows.Count).End(xlUp).Row
            wsAddressS_4.Cells(LastRow4 + 1, 1).Value = wsAddressS_1.Cells(1 + I, 1).Value
            wsAddressS_4.Cells(LastRow4 + 1, 2).Value = wsAddressS_1.Cells(1 + I, 2).Value
            wsAddressS_4.Cells(LastRow4 + 1, 3).Value = wsAddressS_1.Cells(1 + I, 3).Value
            wsAddressS_4.Cells(LastRow4 + 1, 4).Value = wsAddressS_1.Cells(1 + I, 4).Value
            wsAddressS_4.Cells(LastRow4 + 1, 5).Value = wsAddressS_1.Cells(1 + I, 5).Value
            wsAddressS_4.Cells(LastRow4 + 1, 6).Value = wsAddressS_1.Cells(1 + I, 6).Value

End If

    Sleep 10
    DoEvents
Next I

например, VLookLike

Private Function VLookLike(txt As String, rng As Range) As String
Dim temp As String, e, n As Long, a()
Static RegX As Object
If RegX Is Nothing Then
    Set RegX = CreateObject("VBScript.RegExp")
    With RegX
        .Global = True
        .IgnoreCase = True
        .Pattern = "(\S+).*" & Chr(2) & ".*\1"
    End With
End If
With RegX
    For Each e In rng.Value
        If UCase$(e) = UCase(txt) Then
            VLookLike = e
            Exit For
        End If
        temp = Join$(Array(e, txt), Chr(2))
        If .test(temp) Then
            n = n + 1
            ReDim Preserve a(1 To 2, 1 To n)
            a(2, n) = e
            Do While .test(temp)
                a(1, n) = a(1, n) + Len(.Execute(temp)(0).submatches(0))
                temp = Replace(temp, .Execute(temp)(0).submatches(0), "")
            Loop
        End If
    Next
End With
If (VLookLike = "") * (n > 0) Then
    With Application
        VLookLike = .HLookup(.Max(.Index(a, 1, 0)), a, 2, False)
    End With
End If
End Function

Любая помощь или предложения будут высоко оценены!

Answer 1

Я не прочитал весь код, извините, но у меня были проблемы при сравнении строк.Возможно, это сработает, если вы скажете vba, что вы собираетесь сравнивать 2 строки.Вы можете использовать функцию Cstr (), например,

CStr(Left(UCase(StrAddress), 3)) = CStr(Left(UCase(VLookLike(StrAddress, rng2)), 3))