连续序列号生成（包括重复值）答案

【问题标题】：Continuous serial number generation (incl. duplicate values)连续序列号生成（包括重复值）
【发布时间】：2020-12-27 01:05:17
【问题描述】：

我正在尝试创建一个 VBA 宏，它根据 A 列中给出的值列表在 B 列中分配一个唯一序列号 >。我设法想出了一个简单的宏，它为电子表格中的每一行分配一个序列号（无论值如何）。

但是，我的工作簿还包含列 A 中的重复条目，我希望 唯一序列 重复这些条目，直到下一个新字符串。

Sub serialgenerator()
Dim LastRow As Long
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Cells(2, 2).Formula = CLng("1")
Cells(2, 2).Autofill Destination:=Range(Cells(2, 2), Cells(LastRow, 2)), Type:=xlFillSeries
End Sub

【问题讨论】：

首先在B2中输入值1，在B3中输入这个函数=IF(A2=A3,B2,B2+1)。不，您可以将此函数从 B3 复制到列表末尾。
A列中的数字是否按递增排列？
嗨，Ivan，不具体，但我绝对可以在运行宏之前设置它

标签： excel vba

【解决方案1】：

这就是诀窍：

'demo    
Cells.Clear
bigno = 12345
For i = 1 To 20
Cells(i, 1) = bigno
If Rnd > 0.8 Then bigno = bigno + Int(Rnd * 10000) + 10000
Next i
'code
usn = 1
Cells(1, 2) = usn
For i = 2 To 20
If Cells(i, 1) <> Cells(i - 1, 1) Then usn = usn + 1
Cells(i, 2) = usn
Next i

如果一个单元格与其前一个单元格不同，则增加唯一序列号，否则保持不变。

【讨论】：

【解决方案2】：

唯一（字典、数组）

Option Explicit

Sub SerialGenerator()
    
    ' Define Last Row.
    Dim LastRow As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Write Source Range to Data Array.
    Dim rng As Range: Set rng = Range(Cells(2, 1), Cells(LastRow, 1))
    Dim Data As Variant: Data = rng.Value
    
    ' Using the dictionary, get the unique values and at the same time
    ' write them to Data Array overwriting the original values with
    ' the unique values for each row.
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim Curr As Variant, i As Long, j As Long
    For i = 1 To UBound(Data)
        Curr = Data(i, 1)
        If Not IsError(Curr) Then
            If Not IsEmpty(Curr) Then
                If Not dict.Exists(Curr) Then
                    j = j + 1
                    dict(Curr) = j
                End If
                Data(i, 1) = dict(Curr)
            'Else ' IsEmpty(Curr)
            End If
        'Else ' IsError(Curr)
            'data(i,1) = Empty
        End If
    Next i
    
    ' Write values from Data Array to Target Range.
    rng.Offset(, 1).Value = Data

    ' Inform user.
    MsgBox "Done."

End Sub

【讨论】：

【解决方案3】：

只要您对 A 列进行了排序，它们就按数字顺序排列（因为它像 10,10,11,12,12,13 而不是 10,11,12,10,13,12 等）那么这段代码可能就这么简单了：

Dim lastrow As Long, Counter As Long

lastrow = Range("A" & Rows.Count).End(xlUp).Row
Counter = 0

For i = 2 To lastrow
    If Range("A" & i) <> Range("A" & i - 1) Then
        Counter = Counter + 1
        Range("B" & i) = Counter
    Else
        Range("B" & i) = Counter
    End If
Next i

【讨论】：