EXCEL VBA：涉及检查重复项和继续串行的循环

Question

我是使用 VBA 的新手，我正在尝试做一些看起来“简单”的事情。我让我的 VBA 代码生成一个字符串 (CP20210100001)，我希望我的 for 循环检查该字符串是否已在该列中使用。如果已经使用，则在序列中生成下一个，直到生成序列中的下一个唯一值。

我的老板想偶尔在列中粘贴不同的 ID，这会干扰代码。我的代码查看最后一行并将一个添加到 String + 序列中。这将导致重复。

我通过谷歌搜索找到了代码来检查重复项的当前值，但我无法弄清楚如何让它检查系列中的未来 ID，直到它遇到一个唯一值。

您可以在下面看到我的专栏。我有 10 次成功提交，然后我的老板粘贴了 3 行。使用我的 VBA，下一个生成的 ID 将是 CP20210200004，但代码的最后一部分发现它是重复的，因此它添加了 1 并输入了 CP20210200005。理想情况下，VBA 应该 for 循环，直到序列中的下一个出现。在这种情况下，CP20210200011。这样，无论我的老板扰乱我的餐桌多少次，我的 ID 序列都会保持完整。

**Reference ID**
CP20210100000
CP20210200001
CP20210200002
CP20210200003
CP20210200004
CP20210200005
CP20210200006
CP20210200007
CP20210200008
CP20210200009
CP20210200010
JS20210200001
JS20210200002
JS20210200003
CP20210200005

下面是VBA

#Timestamp is part of the String + Serial Combo

Timestamp = Format(Year(Date)) + Format(Month(Date), "00")

#I found this online. Essentially if A2 is blank then input CP + Timestamp + 00001 (CP20210100001)
#It looks at the last row to find the old value (OVAL) and generate the new value (NVAL)

If Sheets(ws_output).Range("A2") = "" Then
Sheets(ws_output).Range("A2").Value = "CP" & Timestamp + 1
 Else
 lstrow = Sheets(ws_output).Cells(Rows.Count, "A").End(xlUp).Row
 Oval = Sheets(ws_output).Range("A" & lstrow)
 NVAL = "CP" & Timestamp & Format(Right(Oval, 4) + 1, "00000")

#Here I am trying to see if NVAL is a duplicate value. If so add one to the serial.

 Count = Application.WorksheetFunction.Countif(Sheets(ws_output).Range("A2:A100000"), NVAL)
 Dim Cell As Range
 For Each Cell In Sheets(ws_output).Range("A2:A100000")
    If Count > 1 Then
    NXVAL = NVAL
    Else
    NXVAL = "CP" & Timestamp & Format(Right(NVAL, 4) + 1, "00000")
End If
Next

请帮忙。

编辑

我应该澄清一下，所有这些都是在表单上触发的。该模块连接到一个提交按钮。按下按钮后，表单中的所有值都会写入单独的工作表。参考 ID 是唯一不在表单上的部分。本质上，一旦按下按钮，它就会触发查询以写入下一个可用的参考 ID。查询中的下一行是

Sheets("Sheet2").Cells(next_row, 1).Value = NXVAL

我需要新的参考 ID 来等于一个变量。

Answer 1

您的代码似乎给您带来了很多悲伤和很少的安慰。原因是你没有采取严格的逻辑方法。任务是...

1. 查找最后使用的号码。建议使用VBA自带的Find函数。
2. 插入下一个数字。它由前缀、日期和序列号组成。

所以，你得到这样的代码：-

Sub STO_66112119()
    ' 168

    Const NumClm    As Long = 1         ' 1 = column A
    Dim Prefix      As String
    Dim LastNumber  As Long
    Dim Fnd         As Range            ' search result
    
    Prefix = "JS"                       ' you could get this from an InputBox to
                                        ' enable numbering for other prefixes
    With Columns(NumClm)
        On Error Resume Next            ' if column A is blank
        Set Fnd = .Find(What:=Prefix, _
                        After:=.Cells(1, 1), _
                        LookIn:=xlValues, _
                        Lookat:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False)
    End With
    LastNumber = Val(Right(Fnd.Value, 5))

    On Error GoTo 0
    Cells(Rows.Count, NumClm).End(xlUp).Offset(1).Value = Prefix & Format(Date, "yyyymm") _
                                                        & Format(LastNumber + 1, "00000")
End Sub

不过，您需要花一点时间进行准备。

1. 定义要使用的列。我把它放在Const NumClm 中。它位于代码的顶部，以便于维护（不需要挖掘代码来进行更改）。
2. 我的代码显示Prefix = "JS"。您想将其更改为“CP”。我插入了“JS”以表明您可以使用任何前缀。

上面的代码将在新的一个月甚至新的一年继续计数。如果您想每年从一个新系列开始，只需改变您处理以前找到的系列的方式。 Find 函数将返回最后使用前缀的单元格。您可以进一步检查该单元格的值。