Sub m()
Dim myCol As Collection
Set myCol = New Collection
For i = 1 To [a1].End(xlDown).Row
t = 1
On Error Resume Next
t = Val(Split(myCol(CStr(Cells(i, 1))), "/")(1)) + 1
myCol.Remove (CStr(Cells(i, 1)))
On Error GoTo 0
myCol.Add cstr(Cells(i, 1)) & "/" & t, cstr(Cells(i, 1))
Next
For i = 1 To myCol.Count
Debug.Print myCol(i)
Next
End Sub
Пример
Audi
Audi
BMW
Ford
Ford
Ford