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

问题描述

我有一个数字列表(50,000+)，我需要在每个唯一组的末尾添加一个ID.ID的格式为-###".

I have a list of numbers (50,000+) and I need to add a Id to the end of each unique group. The Id is in a format of "-###".

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处计算唯一值，那么我相信这会解决它.

I currently have this code that I found and modified slightly. If I could get it to start counting unique values at -002 then I believe that would solve it.

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

谢谢所有！

推荐答案

我知道您要求使用vba，但是一个简单的公式将为您提供所需的输出.

I know you asked for vba, but a simple formula will give you the desired output.

在B1中放:

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

并复制数据范围.

如果要在vba中使用它；我会做这样的事情:

If you want it in vba; I would do something like this:

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

与上述公式的作用相同.

Which effectively does the same as the above formula.

这篇关于将唯一的ID添加到数字列表-VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！