如何通过VBA遍历数组生成带唯一标识的抽奖名单？

功能说明 #

根据指定区域的姓名和对应购票数，批量生成「姓名+序号」格式的抽奖条目，替代硬编码方式，通过数组遍历提升运行效率。

实现代码 #

Sub raffleTickets()
    Dim wsSource As Worksheet
    Dim namesArr As Variant, ticketsArr As Variant
    Dim outputWs As Worksheet
    Dim i As Long, j As Long, outputRow As Long
    
    ' 指定数据源工作表（请根据实际表名修改）
    Set wsSource = ThisWorkbook.Worksheets("数据源")
    
    ' 一次性读取姓名和购票数到数组
    namesArr = wsSource.Range("A5:A135").Value
    ticketsArr = wsSource.Range("I5:I135").Value
    
    ' 创建/获取输出工作表
    On Error Resume Next
    Set outputWs = ThisWorkbook.Worksheets("抽奖名单")
    If Err.Number <> 0 Then
        Set outputWs = ThisWorkbook.Worksheets.Add(After:=wsSource)
        outputWs.Name = "抽奖名单"
    End If
    On Error GoTo 0
    
    ' 初始化输出表头和起始行
    outputRow = 1
    outputWs.Cells(outputRow, 1).Value = "抽奖条目"
    outputRow = outputRow + 1
    
    ' 遍历数组生成抽奖条目
    For i = LBound(namesArr, 1) To UBound(namesArr, 1)
        ' 跳过空姓名或无效购票数
        If Trim(namesArr(i, 1)) <> "" And ticketsArr(i, 1) > 0 Then
            For j = 1 To ticketsArr(i, 1)
                outputWs.Cells(outputRow, 1).Value = namesArr(i, 1) & j
                outputRow = outputRow + 1
            Next j
        End If
    Next i
    
    ' 自动适配列宽
    outputWs.Columns(1).AutoFit
    
    MsgBox "抽奖名单生成完成！", vbInformation
End Sub

关键细节 #

• 数组读取：使用Range.Value批量加载数据，比逐个读取单元格的硬编码方式效率提升明显
• 异常处理：自动判断输出工作表是否存在，避免重复创建报错
• 有效性校验：跳过空姓名、购票数为0或负数的无效数据
• 条目生成：外层循环遍历每个参与者，内层循环根据购票数生成对应序号的条目

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