VBA子程序求助：判断单元格前缀并生成指定格式8位随机数

问题拆解 #

你碰到的两个核心问题我都帮你梳理清楚了：

• 前缀判断失效：大概率是单元格内容的类型（数值/文本）差异，导致Left函数没法正确提取前6位字符
• 随机数不符合要求：需要生成18开头的8位唯一数，还要避免重复生成相同的数字

修正后的完整代码 #

Sub Opgave8()
    Dim ws As Worksheet
    Dim i As Long
    Dim generatedNumbers As New Collection ' 存已生成的随机数，确保不重复
    Dim randomNum As String
    Dim isUnique As Boolean
    
    ' 提前引用目标工作表，减少重复调用的开销
    Set ws = ThisWorkbook.Worksheets("arab")
    
    ' 遍历第2行到18288行的第12列（也就是L列）
    For i = 2 To 18288
        ' 先把单元格内容转成字符串，再判断前6位是否为"262015"
        If Left(CStr(ws.Cells(i, 12).Value), 6) = "262015" Then
            ' 循环生成直到拿到唯一的随机数
            Do
                ' 生成6位固定长度的随机数，拼接"18"得到8位目标数
                randomNum = "18" & Format(Int(Rnd() * 900000) + 100000, "000000")
                ' 检查这个数是否已经生成过
                isUnique = True
                On Error Resume Next ' 捕获集合中不存在元素的错误
                generatedNumbers.Add randomNum, Key:=randomNum
                If Err.Number <> 0 Then
                    isUnique = False
                    Err.Clear
                End If
                On Error GoTo 0 ' 恢复默认错误处理
            Loop Until isUnique
            
            ' 把生成的随机数写入目标单元格，这里默认写在第13列（M列），你可以自己调整位置
            ws.Cells(i, 13).Value = randomNum
        End If
    Next i
    
    ' 释放对象，避免内存占用
    Set ws = Nothing
    Set generatedNumbers = Nothing
    
    MsgBox "处理完成！", vbInformation
End Sub

关键修正说明 #

• 前缀判断优化：用CStr()强制把单元格内容转为字符串，不管单元格是数值格式还是文本格式，都能准确提取前6位进行匹配
• 唯一随机数生成：
  • 用Collection的Key特性确保随机数唯一，重复的Key会触发错误，以此判断是否需要重新生成
  • 用Format(..., "000000")保证6位随机数是固定长度，避免出现比如181234这种不足8位的情况
  • 用Do...Loop循环直到生成不重复的数字
• 效率提升：提前引用工作表对象ws，避免循环里反复调用Worksheets("arab")，加快运行速度

额外小技巧 #

如果你的数据量很大（18000多行），可以在循环前后加上这段代码，关闭屏幕更新和事件触发，让程序跑更快：

' 循环前添加
Application.ScreenUpdating = False
Application.EnableEvents = False

' 循环结束后恢复
Application.ScreenUpdating = True
Application.EnableEvents = True

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