Sub CreerListes()
With Feuil2.[A5:B6000] 'plage de 2 colonnes, à adapter
.Formula = "=TEXT(RANDBETWEEN(1,1200),""P0000"")" 'ALEA.ENTRE.BORNES
.Value = .Value 'supprime les formules
Call Comparer(.Cells, Feuil2.[E5]) 'cellule de restitution à adapter
End With
End Sub
Sub Comparer(plage As Range, restit As Range)
Dim d1 As Object, d2 As Object, t, i&, a, manque(), m&, plus(), p&
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
d2.CompareMode = vbTextCompare 'la casse est ignorée
'---listes sans doublons---
t = plage.Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(t): d1(t(i, 1)) = "": Next
For i = 1 To UBound(t): d2(t(i, 2)) = "": Next
'---manque---
If d1.Count Then
a = d1.keys
ReDim manque(1 To d1.Count, 1 To 1)
For i = 0 To UBound(a)
If Not d2.exists(a(i)) Then m = m + 1: manque(m, 1) = a(i)
Next
End If
'---plus---
If d2.Count Then
a = d2.keys
ReDim plus(1 To d2.Count, 1 To 1)
For i = 0 To UBound(a)
If Not d1.exists(a(i)) Then p = p + 1: plus(p, 1) = a(i)
Next
End If
'---restitution sur restit et tris---
Application.ScreenUpdating = False
restit.Resize(Rows.Count - restit.Row + 1, 2) = "" 'RAZ
If m Then restit.Resize(m) = manque: restit.Resize(m).Sort restit
If p Then restit(1, 2).Resize(p) = plus: restit(1, 2).Resize(p).Sort restit(1, 2)
Set restit = Cells.Find(restit, , xlValues, , xlByColumns) 'initialise la boîte de dialogue Rechercher
End Sub