Т.е. это уже четвёртая ступень проверки - когда не прошли предыдущие проверки?
Да, работает, на "Садыкововне" выводит разницу (в моём примере):
Option Explicit
Sub compare()
Dim temp$, a(), b(), iLastrow As Long, i As Long, el
'1.два диапазона в два массива
With Sheet1 'используется кодовое имя
iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
a = Range(.[E2], .Range("A" & iLastrow)).Value
End With
With Sheet2 'используется кодовое имя
iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
b = Range(.[E2], .Range("A" & iLastrow)).Value
End With
'2.создание массива для результатов
ReDim c(1 To UBound(b), 1 To 1)
'3.один перебор 100000*2 значений массива в словарь
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For i = 1 To UBound(a)
'в словарь Ф+И+О+ДР (в итем счёт)
temp = Trim(a(i, 1)) & "|" & _
Trim(a(i, 2)) & "|" & _
Trim(a(i, 3)) & "|" & _
Trim(a(i, 4))
If Not .exists(temp) Then
ReDim d(0 To 0)
d(0) = Trim(a(i, 5))
.Item(temp) = d
Else
d = .Item(temp)
ReDim Preserve d(UBound(d) + 1)
d(UBound(d)) = Trim(a(i, 5))
.Item(temp) = d
End If
'в словарь Ф+И+О+счёт (в итем ДР)
temp = Trim(a(i, 1)) & "|" & _
Trim(a(i, 2)) & "|" & _
Trim(a(i, 3)) & "|" & _
Trim(a(i, 5))
If Not .exists(temp) Then
ReDim d(0 To 0)
d(0) = Trim(a(i, 4))
.Item(temp) = d
Else
d = .Item(temp)
ReDim Preserve d(UBound(d) + 1)
d(UBound(d)) = Trim(a(i, 4))
.Item(temp) = d
End If
'в словарь счёт (в итем Ф+И+О+ДР)
temp = Trim(a(i, 5))
If Not .exists(temp) Then
ReDim d(0 To 0)
d(0) = Trim(a(i, 1)) & "|" & _
Trim(a(i, 2)) & "|" & _
Trim(a(i, 3)) & "|" & _
Trim(a(i, 4))
.Item(temp) = d
Else
d = .Item(temp)
ReDim Preserve d(UBound(d) + 1)
d(UBound(d)) = Trim(a(i, 1)) & "|" & Trim(a(i, 2)) & "|" & Trim(a(i, 3)) & "|" & Trim(a(i, 4))
.Item(temp) = d
End If
Next
'4.500000*2 проверок массива на наличие в словаре и заполнение массива результата
For i = 1 To UBound(b)
temp = Trim(b(i, 1)) & "|" & _
Trim(b(i, 2)) & "|" & _
Trim(b(i, 3)) & "|" & _
Trim(b(i, 4))
If .exists(temp) Then
d = .Item(temp)
For Each el In d
If el = Trim(b(i, 5)) Then
c(i, 1) = "совпало"
Exit For
End If
Next
If c(i, 1) <> "совпало" Then c(i, 1) = "не совпало по счёту: " & Join(d, "|")
Else
temp = Trim(b(i, 1)) & "|" & _
Trim(b(i, 2)) & "|" & _
Trim(b(i, 3)) & "|" & _
Trim(b(i, 5))
If .exists(temp) Then
d = .Item(temp)
c(i, 1) = "не совпало по дате: " & Join(d, "|")
Else
temp = Trim(b(i, 5))
If .exists(temp) Then
d = .Item(temp)
c(i, 1) = "не совпало по Ф+И+О+ДР: " & Join(d, "|")
Else
c(i, 1) = "не совпало вообще!!!"
End If
End If
End If
Next
End With
'5.выгрузка результатов
With Sheet2 'используется кодовое имя
.[G2].Resize(i - 1) = c
End With
End Sub
