将唯一ID添加到数字列表 - VBA

Question

我有一个数字列表（50,000+），我需要在每个唯一组的末尾添加一个Id。 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

有效地与上述公式相同。