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