Sok sor és A oszlop esetén:
Sub szamolo()
Range("A1").Select
usor = ActiveSheet.UsedRange.Rows.Count
For sor = 1 To usor
Nev = Cells(sor, 1): sz = 1 ': szam = 0
For k = 1 To Len(Nev)
If Mid(Nev, k, 1) = Mid(Nev, k + 1, 1) Then
sz = sz + 1
Else
szam = sz
sz = 1
Cells(sor, 2) = Cells(sor, 2) & szam & ","
End If
Next
Nev = Cells(sor, 2)
Cells(sor, 2) = Left(Nev, Len(Nev) - 1)
Next
End Sub