Bonjour
Bonjour à tous
Un essai à tester. Te convient-il ?
Option Explicit
Dim tablo1, tablo2, tabloR(), dico2 As Object
Dim i1&, i2&, j&
Sub Comparaison()
tablo1 = Sheets("Feuil1").Range("Tableau1")
tablo2 = Sheets("Feuil2").Range("A1").CurrentRegion
Set dico2 = CreateObject("Scripting.Dictionary")
For i2 = 2 To UBound(tablo2, 1)
dico2(tablo2(i2, 1)) = 0
Next i2
For i2 = 2 To UBound(tablo2, 1)
If tablo2(i2, 1) <> 0 Then
For i1 = 1 To UBound(tablo1, 1)
If tablo1(i1, 1) = tablo2(i2, 1) Then
tablo1(i1, 3) = dico2(tablo2(i2, 1)) + 1
dico2(tablo2(i2, 1)) = dico2(tablo2(i2, 1)) + 1
End If
Next i1
End If
Next i2
Range("A3").Resize(UBound(tablo1, 1), 3) = tablo1
End Sub
Bye !