Sub ColoriageDoublons2col()
Set d1 = New Dictionnaire
Set d2 = New Dictionnaire
Set plage1 = Range("A2", [a65000].End(xlUp))
Set plage2 = Range("B2", [B65000].End(xlUp))
[A:B].Interior.ColorIndex = xlNone
For Each c In plage1
If c <> "" Then d1.ajout(c.Value) = ""
Next c
For Each c In plage2
If d1.Existe(CStr(c.Value)) Then c.Interior.ColorIndex = 3
If c.Value <> "" Then d2.ajout(CStr(c.Value)) = ""
Next c
For Each c In plage1
If d2.Existe(CStr(c.Value)) Then c.Interior.ColorIndex = 4
Next c
End Sub
Sub ListeSansDoublons()
Set d1 = New Dictionnaire
Set plage1 = Range("A2", [a65000].End(xlUp))
For Each c In plage1
If c <> "" Then d1.ajout(c.Value) = ""
Next c
'---- transfert dans le tableur
Set plg = Range("d2").Resize(d1.count)
plg.Value = d1.listeCles
'------- transfert dans un tableau b(,)
b = d1.listeCles
For i = LBound(b) To UBound(b)
Cells(i + 1, "c") = b(i, 1)
Next i
'--- Accès aux clés par un indice
For i = 1 To d1.count
Cells(i + 1, "c") = d1.cle(i)
Next i
End Sub
Private xn
Private Collec As New Collection
Private CollecCle As New Collection
Public Property Let ajout(cle, item)
On Error Resume Next
Collec.Add item:=item, Key:=cle
CollecCle.Add item:=cle, Key:=cle
If Err = 0 Then xn = xn + 1
End Property
Public Property Get count()
count = xn
End Property
Public Property Get listeItems()
Dim temp()
ReDim temp(1 To xn)
For i = 1 To xn
temp(i) = Collec(i)
Next i
listeItems = Application.Transpose(temp)
End Property
Public Property Get listeCles()
Dim temp()
ReDim temp(1 To xn)
For i = 1 To xn
temp(i) = CollecCle(i)
Next i
listeCles = Application.Transpose(temp)
End Property
Public Property Get item(cle)
item = Collec(cle)
End Property
Public Property Get Existe(cle)
On Error Resume Next
retour = Collec(cle)
Existe = (Err = 0)
End Property
Public Property Get cle(indice)
If indice <= xn Then cle = CollecCle(indice) Else cle = ""
End Property