Sub Compter_Unique()
Dim t0, t, n&, i&, ref, nbr&
t0 = Timer
Application.ScreenUpdating = False
t = Range("a1:b" & Cells(Rows.Count, "a").End(xlUp).Row)
Range("f:g").Clear
Range("f:g").Resize(UBound(t)) = t
Range("f:g").Resize(UBound(t)).Sort key1:=Range("f1"), order1:=xlAscending, key1:=Range("g1"), order2:=xlAscending, Header:=xlYes
Range("f:g").Resize(UBound(t)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
t = Range("f1:g" & Cells(Rows.Count, "a").End(xlUp).Row)
n = 2: ref = t(2, 1): nbr = 0
For i = 2 To UBound(t)
If t(i, 1) = ref Then
nbr = nbr + 1
Else
t(n, 1) = ref: t(n, 2) = nbr
nbr = 1: ref = t(i, 1): n = n + 1
End If
Next i
t(n, 1) = ref: t(n, 1) = nbr
Range("f:g").Clear: Range("f:g").Resize(n - 1) = t
Range("f:g").EntireColumn.AutoFit: Range("f1:g1").Interior.Color = RGB(200, 200, 255)
MsgBox "Terminé en: " & Format(Timer - t0, "0.00\ sec.")
End Sub