Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, ub&, i&, x$, n&, j&, k&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With [A1].CurrentRegion
.Columns(1).EntireColumn.Insert 'insère une colonne auxiliaire
.Cells(1, 0) = 1
.Columns(0).DataSeries 'numérotation
.EntireRow.Sort .Columns(1), xlAscending, .Columns(2), Header:=xlYes 'tri sur 2 colonnes
tablo = .Columns(1).Resize(, 2) 'matrice, plus rapide
ub = UBound(tablo)
ReDim resu(1 To ub, 1 To 1)
For i = 2 To ub
If tablo(i, 1) <> tablo(i - 1, 1) Then
x = tablo(i, 1)
n = 0
For j = i + 1 To ub
If tablo(j, 1) <> x Then Exit For
If tablo(j, 2) = tablo(j - 1, 2) Then n = n + 1 'compte les doublons
Next j
n = j - i - n
For k = i To j - 1
resu(k, 1) = n
Next k
i = j - 1
End If
Next i
resu(1, 1) = .Cells(1, 3)
.Columns(3) = resu 'restitution
.EntireRow.Sort .Columns(0), xlAscending, Header:=xlYes 'tri dans l'ordre initial
.Columns(0).EntireColumn.Delete 'supprime la colonne auxiliaire
End With
Application.EnableEvents = True 'réactive les évènements
End Sub