基于日期重置序列的每日递增UID引用系统VBA代码问题求助

原有代码问题 #

• 变量赋值顺序错误：执行Vlookup调用ws1对象时，还未完成ws1的对象赋值，会直接触发运行时错误
• 流水号计数逻辑未加入日期判断，仅直接提取最后一条记录值+1，无法实现跨天自动重置
• 未定义的ws变量属于笔误，会引发编译错误

修正后代码 #

核心逻辑为遍历历史编号统计当日生成数量，自动重置流水号，自动补3位前导零：

Sub GenerateUID()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim nextNum As Long
    Dim ini As String
    Dim todayDateStr As String
    Dim lastRow As Long
    Dim i As Long
    
    ' 优先初始化工作表对象
    Set ws1 = Worksheets("Lookups")
    Set ws2 = Worksheets("SMEXP")
    
    ' 读取用户姓名首字母
    ini = Application.WorksheetFunction.VLookup(Application.UserName, ws1.Range("IniLookup"), 4, 0)
    
    ' 生成当日8位日期字符串
    todayDateStr = Format(Date, "yyyymmdd")
    
    ' 获取历史编号存储列（AB列）的最后一行行号
    lastRow = ws1.Cells(ws1.Rows.Count, "AB").End(xlUp).Row
    nextNum = 1 ' 无当日记录时默认流水号为001
    
    ' 遍历历史编号统计当日已生成数量
    For i = 2 To lastRow
        If Not IsEmpty(ws1.Cells(i, "AB")) Then
            Dim uidParts As Variant
            uidParts = Split(Trim(ws1.Cells(i, "AB").Value), " - ")
            ' 仅统计格式合法的当日编号
            If UBound(uidParts) >= 2 And uidParts(1) = todayDateStr Then
                nextNum = nextNum + 1
            End If
        End If
    Next i
    
    ' 拼接最终UID，流水号补前导零到3位
    Dim finalUID As String
    finalUID = ini & " - " & todayDateStr & " - " & Format(nextNum, "000")
    
    ' 写入目标单元格
    ws2.Range("B15").Value = finalUID
    
    ' 把新生成的UID存入历史列，供后续计数使用
    ws1.Cells(lastRow + 1, "AB").Value = finalUID
End Sub

注意事项 #

• Lookups工作表的AB列需留存所有历史生成的UID，不可随意删除，否则会导致计数错误
• 若单日需要生成超过999个编号，可将代码中Format(nextNum, "000")的000修改为对应位数的占位符即可
• 多用户同时操作时建议添加工作表锁定逻辑，避免同时生成编号时计数冲突

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