Comparaison 2 listes 2 colonnes

Option Base 1
 Sub test()
 Dim tabA() As Variant
 
Set listeA = ThisWorkbook.Worksheets("liste A")
Set listeB = ThisWorkbook.Worksheets("liste B")
 
' Nettoyage
derLa = listeA.Range("F2").End(xlDown).Row 'utiliser xldown car xlup te comptabilise la cellule A19
listeA.Range(listeA.Cells(1, 6), listeA.Cells(derLa, 10)).Clear
derLa = Empty

derLa = listeA.Range("a2").End(xlDown).Row 'utiliser xldown car xlup te comptabilise la cellule A19
derLb = listeB.Range("a2").End(xlDown).Row 'utiliser xldown car xlup te comptabilise la cellule A19
 
' Nettoyage format
listeA.Range(listeA.Cells(1, 1), listeA.Cells(derLa, 2)) = Application.Trim(listeA.Range(listeA.Cells(1, 1), listeA.Cells(derLa, 2))) ' 'Supprime tous les espaces en trop exemple : 3 espaces entre "un   et" = "un et"
listeB.Range(listeB.Cells(1, 1), listeB.Cells(derLb, 2)) = Application.Trim(listeB.Range(listeB.Cells(1, 1), listeB.Cells(derLb, 2))) ' 'Supprime tous les espaces en trop exemple : 3 espaces entre "un   et" = "un et"
 
' Tableau
a = listeA.Range(listeA.Cells(1, 1), listeA.Cells(derLa, 2)) ' Liste A
B = listeB.Range(listeB.Cells(1, 1), listeB.Cells(derLb, 2)) ' liste B
 
' compteur nombe de ligne tableau a + b
n = (UBound(a, 1) + UBound(B, 1))

' demension nouveau tableau
ReDim tabA(1 To n, 1 To 5)

For i = 1 To UBound(a, 1)
tabA(i, 1) = a(i, 1)
tabA(i, 2) = a(i, 2)
tabA(i, 3) = "Liste A"
Next i
 
a = UBound(a, 1)
 
For j = 1 To UBound(B, 1)
a = a + 1
tabA(a, 1) = B(j, 1)
tabA(a, 2) = B(j, 2)
tabA(a, 3) = "Liste B"
Next j
 
' Doublon
 For i = 1 To n
 d = i + 1
     For j = d To n
         If tabA(i, 1) & tabA(i, 2) = tabA(j, 1) & tabA(j, 2) Then
             tabA(j, 4) = tabA(j, 4) + 1
             tabA(i, 5) = "Existe tableau B"
             tabA(j, 5) = "Existe tableau A"
         End If
     Next j
 Next i
 
' Unique !
 For i = 1 To n
         If tabA(i, 5) = Empty Then
             tabA(i, 5) = "unique !"
         End If
 Next i

tabA(1, 3) = "Liste"
tabA(1, 5) = "Existe Ou Unique !"

For i = 1 To 3
     listeA.Cells(1, 6).Offset(0, k).Resize(UBound(tabA, 1)) = Application.Index(tabA, , i)
     k = k + 1
 Next i
     listeA.Cells(1, 9).Resize(UBound(tabA, 1)) = Application.Index(tabA, , 5)
 
' Trie
    derLa = listeA.Range("F2").End(xlDown).Row 'utiliser xldown car xlup te comptabilise la cellule A19

    listeA.Range(listeA.Cells(1, 6), listeA.Cells(derLa, 10)).Select

    Selection.Sort Key1:=Range("F2"), Order1:=xlAscending, Key2:=Range("G2") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
        , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal
End Sub