Что-то вроде. Алгоритм немного отличается от слэнова - тут один словарь. Поэтому в двух массивах выгружаются все записи, попадающие под условие, а в третьем только уникальные.
Но если списки изначально уникальные, то во всех массивах будут уникальные.
Option Explicit
Sub FindValues()
Dim a, aa, b, bb, bbb, i&, ii&, iii&, dic As Object, x
'a = Range("a1:a20")
a = Range([A1], Range("A" & Rows.Count).End(IIf(Len(Range("A" & Rows.Count)), xlDown, xlUp)))
'b = Range("b1:b20")
b = Range([B1], Range("B" & Rows.Count).End(IIf(Len(Range("B" & Rows.Count)), xlDown, xlUp)))
ReDim aa(1 To UBound(a), 1 To 1)
ReDim bb(1 To UBound(b), 1 To 1)
ReDim bbb(1 To UBound(b), 1 To 1)
Set dic = CreateObject("Scripting.Dictionary")
For Each x In a
If dic.exists(CStr(x)) Then
Else
dic.Add CStr(x), 0
End If
Next
For Each x In b
If dic.exists(CStr(x)) Then
dic.Item(CStr(x)) = 1 'признак, что есть в b()
iii = iii + 1
bbb(iii, 1) = x 'массив тех, кто из b() есть в a()
Else
ii = ii + 1
bb(ii, 1) = x 'массив тех, кого из b() нет в а()
End If
Next
For Each x In dic
If dic.Item(x) = 0 Then
i = i + 1
aa(i, 1) = x 'массив тех, кого из a() нет в b()
End If
Next
[d1] = "из B есть в A: " & iii
[d2].Resize(iii, UBound(bbb, 2)).Value = bbb 'выгружаем результат
[e1] = "из B нет в A: " & ii
[e2].Resize(ii, UBound(bb, 2)).Value = bb 'выгружаем результат
[f1] = "из A нет в B (уникальные): " & i
[f2].Resize(i, UBound(a, 2)).Value = aa 'выгружаем результат
End Sub
