bonjour Yoyo , bonjour Bernard
j'espère que cette adaptation te conviendra . le résultat s'affiche dans les colonne 9 et 10
Sub CompterLesNomsIdentiques_V02()
Dim Cell As Range
Dim Ligne As Integer, I As Integer
Dim M As Byte
Dim U As Boolean
Dim Tableau()
Dim Resultat As String
Ligne = Range("A65536").End(xlUp).Row'adapter la colonne de référence
M = 1
ReDim Preserve Tableau(2, M)
For Each Cell In Range("B4:B" & Ligne)
U = False
For I = 1 To M
If Cell = Tableau(0, I - 1) Then
Tableau(1, I - 1) = Tableau(1, I - 1) + 1
U = True
End If
Next I
If Tableau(1, M - 1) = "" And U = False Then
Tableau(0, M - 1) = Cell
Tableau(1, M - 1) = 1
M = M + 1
ReDim Preserve Tableau(2, M)
End If
Next Cell
For I = 1 To M - 1
Cells(I, 9) = Tableau(0, I - 1) 'colonne 9
Cells(I, 10) = Tableau(1, I - 1) 'colonne 10
Next I
End Sub
bonne journée
MichelXld