1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
| 'Ajouter la référence "Microsoft scripting runtime"
Sub CompteurAvecFiltre()
Dim filtre As New Dictionary
Dim compteurs As New Dictionary
Dim vals As Variant
Dim lastline As Long
lastline = Range("A1").End(xlDown).Row
vals = Range("A1:B" & lastline)
Dim li As Long
Dim key As String
For li = 1 To UBound(vals, 1)
If compteurs.Exists(vals(li, 2)) Then
If Not (filtre.Exists(vals(li, 1) & vals(li, 2))) Then
compteurs.Item(vals(li, 2)) = CLng(compteurs.Item(vals(li, 2))) + 1
End If
Else
Call compteurs.Add(vals(li, 2), 1)
Call filtre.Add(vals(li, 1) & vals(li, 2), 1)
End If
Next li
Dim vali As Long
Range("C1").Value = "Code"
Range("D1").Value = "Compteur"
For vali = 0 To compteurs.Count - 1
Range("C1").Offset(vali).Value = compteurs.Keys(vali)
Range("D1").Offset(vali).Value = compteurs.Items(vali)
Next vali
Set filtre = Nothing
Set compteurs = Nothing
End Sub |
Partager