VBA生成唯一采购订单号异常：无法生成序号大于-2的单号求助

看起来你的代码逻辑在处理多个已存在PO号时有点小疏漏——它只会逐个检查当前生成的PO号是否存在，而没有统计所有以当日日期开头的PO号的最大后缀，这就导致如果存在比当前检查的PO号后缀更大的记录时，代码会漏掉，无法生成正确的下一个单号。

原代码的核心问题 #

举个例子：如果你的A列已经有20240520-1和20240520-3，原代码会先生成20240520-1，发现存在后改成20240520-2，但遍历到20240520-3时，因为当前PO号是20240520-2，两者不相等，所以不会继续增加后缀，最终生成的是20240520-2，而正确的应该是20240520-4。

修改后的代码（高效且准确） #

Sub GeneratePONumber()
    Dim ws2 As Worksheet
    Dim ponum As String
    Dim podate As String
    Dim maxNum As Integer
    Dim lastRow As Long
    Dim c As Range
    
    ' 初始化工作表对象，避免激活操作（更高效）
    Set ws2 = ThisWorkbook.Worksheets("Data Sheet")
    ws2.Unprotect "1896"
    
    ' 获取当日日期（用Date而非Now，只取日期部分）
    podate = Format(Date, "yyyymmdd")
    maxNum = 0 ' 初始最大后缀为0
    
    ' 找到A列最后一行数据，避免遍历十万行浪费资源
    lastRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历所有已存在的PO号
    For Each c In ws2.Range("A1:A" & lastRow)
        ' 检查单元格内容是否以当日日期开头，格式为"yyyymmdd-数字"
        If c.Value <> "" And c.Value Like podate & "-*" Then
            ' 提取后缀数字并转换为整数
            currentSuffix = CInt(Split(c.Value, "-")(1))
            ' 更新最大后缀
            If currentSuffix > maxNum Then
                maxNum = currentSuffix
            End If
        End If
    Next c
    
    ' 生成新的PO号：最大后缀+1
    ponum = podate & "-" & (maxNum + 1)
    
    ' 这里可以添加将PO号写入工作表的代码，比如写入A列最后一行的下一行
    ' ws2.Cells(lastRow + 1, "A").Value = ponum
    
    ws2.Protect "1896"
End Sub

代码改进点说明 #

• 避免激活工作表：直接使用工作表对象操作，比Activate更高效且不易出错
• 精准遍历范围：找到A列最后一行数据，不用遍历十万行，节省资源
• 统计最大后缀：遍历所有以当日日期开头的PO号，提取后缀并记录最大值，确保生成的下一个单号是连续的
• 使用Date而非Now：PO号通常只需要日期，不需要时间部分，避免同一日期内因为时间不同导致的问题

测试场景验证 #

• 第一次运行：无PO号 → 生成yyyymmdd-1
• 已有yyyymmdd-1、yyyymmdd-2 → 生成yyyymmdd-3
• 已有yyyymmdd-1、yyyymmdd-3 → 生成yyyymmdd-4
• 存在重复PO号（比如两个yyyymmdd-2） → 仍生成yyyymmdd-3（因为最大后缀还是2）

内容的提问来源于stack exchange，提问作者stacy henderson