Добавить уникальный идентификатор в список номеров - VBA

Question

У меня есть список номеров (50 000+), и мне нужно добавить Id в конец каждой уникальной группы. Идентификатор находится в формате «- ###».

151022 
151022 
151020 
150922 
150715 
150911 
151014 
151021 
151020 
151019 
151019 
151019 
151020 

мне нужно напечатать как этот

151022-001 
151022-002 
151020-001 
150922-001 
150715-001 
150911-001 
151014-001 
151021-001 
151020-002 
151019-001 
151019-002 
151019-003 
151020-002 

настоящее время у меня этот код, который я нашел и слегка измененный. Если бы я мог заставить его начать подсчет уникальных значений при -002, то я считаю, что это решило бы.

Option Explicit 

Sub test() 
    Dim uniqueCounter As New Scripting.Dictionary 
    Dim counter As Long 
    Dim rowCount As Long 
    Dim identifer As String 


    rowCount = ActiveCell.CurrentRegion.Rows.Count 'Whatever code you want to put in to calculate the last row 

    For counter = 1 To rowCount 
     identifer = Sheet1.Cells(counter, 1) 'Put whatever number of combination of cells which the row unique here (maybe it's just the one) 
     If uniqueCounter.Exists(identifer) Then 
      uniqueCounter(identifer) = CLng(uniqueCounter(CStr(Sheet1.Cells(counter, 1)))) + 1 
      Sheet1.Cells(counter, 2) = identifer & "-00" & uniqueCounter(CStr(Sheet1.Cells(counter, 1))) 
     Else 
      uniqueCounter.Add identifer, "0" 
      Sheet1.Cells(counter, 2) = identifer 
     End If 
    Next counter 

End Sub 

Это то, что он в настоящее время отображается:

151022 151022 
151022 151022-001 
151020 151020 
150922 150922 
150715 150715 
150911 150911 
151014 151014 
151021 151021 
151020 151020-001 
151019 151019 
151019 151019-001 
151019 151019-002 
151020 151020-002 

Спасибо всем!

Answer 1

Я знаю, что вы просили vba, но простая формула даст вам желаемый результат.

В B1 положить:

=A1& "-" &TEXT(COUNTIF($A$1:A1,A1),"000") 

И скопируйте степень данных.

---

Если вы хотите его в VBA; Я бы сделал примерно следующее:

Sub test2() 
    Dim rng As Range 
    Dim rngcnt As Range 
    Dim firstrow As Long 
    Dim lastrow As Long 
    Dim columnNumber As Long 
    Dim ws As Worksheet 

    Set ws = Worksheets("Sheet15") 'change to your sheet 
    firstrow = 1 'change to your first row of data 
    columnNumber = 1 'change to the column number 

    With ws 
     lastrow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row 
     For i = firstrow To lastrow 
      .Cells(i, columnNumber + 1) = .Cells(i, columnNumber) & "-" & Format(Application.WorksheetFunction.CountIf(.Range(.Cells(firstrow, columnNumber), .Cells(i, columnNumber)), .Cells(i, columnNumber)), "000") 
     Next i 
    End With 

End Sub 

Что фактически делает то же, что и в приведенной выше формуле.