Поиск

Коллекция с счетчиком дубликатов

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