1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
| Sub test()
Dim Ctr As Long, Dico As Object, C As Range, Ligne As Long
Set Dico = CreateObject("Scripting.Dictionary")
Ligne = 0
For Each C In Range([A1], Cells(Rows.Count, 1).End(xlUp))
If Not Dico.exists(C.Value) Then
Dico.Add C.Value, C.Value
Ctr = Evaluate("COUNTIFS(A:A,""" & C.Value & """,B:B,""" & C.Offset(, 1).Value & """)")
Ligne = Ligne + 1
If Not Ctr = 1 Then
Cells(Ligne, 6) = C.Value
Cells(Ligne, 7) = C.Offset(, 1).Value
Cells(Ligne, 8) = Ctr
End If
End If
Next C
End Sub |
Partager