VBA调用Randbetween生成抽奖随机数时如何避免出现重复值

方案1：重复生成直到获取唯一值（逻辑简单，符合你的需求） #

这个方案就是你提到的思路：每次生成随机数后校验是否已经出现过，出现过就重新生成，直到凑够需要的400个名额，对VBA初学者非常友好，容易理解和修改。
示例代码如下：

Sub 抽取不重复中奖名额()
    Dim totalEmp As Long, drawCount As Long
    Dim existedDict As Object, rndNum As Long
    ' 配置参数：员工总数、需抽取的获奖名额
    totalEmp = 1200 ' 这里可以替换为你动态统计员工总数的代码，比如 Range("A" & Rows.Count).End(xlUp).Row
    drawCount = 400
    ' 调用字典存储已生成的随机数，用来快速判断重复
    Set existedDict = CreateObject("Scripting.Dictionary")
    
    Randomize ' 初始化随机数种子，避免每次打开Excel生成的随机序列固定
    ' 循环生成直到凑够指定数量的不重复随机数
    Do While existedDict.Count < drawCount
        rndNum = WorksheetFunction.RandBetween(1, totalEmp)
        ' 仅当当前随机数未生成过时才存入字典
        If Not existedDict.Exists(rndNum) Then
            existedDict.Add rndNum, rndNum
        End If
    Loop
    
    ' 后续你可以直接遍历existedDict的Key去匹配员工姓名，示例是把结果输出到B列
    Range("B1:B" & drawCount) = WorksheetFunction.Transpose(existedDict.Keys)
    
    Set existedDict = Nothing
End Sub

方案2：洗牌法（效率更高，适合抽取数量较多的场景） #

如果你后续需要抽取的名额更多，推荐用洗牌法：先把所有员工的序号存入数组，打乱数组顺序后直接取前N个作为中奖名额，完全不会产生重复值，运行效率更高。
示例代码如下：

Sub 洗牌法抽取不重复名额()
    Dim totalEmp As Long, drawCount As Long
    Dim numArr(), i As Long, temp As Long, rndIndex As Long
    ' 配置参数
    totalEmp = 1200 ' 可替换为动态统计总人数的代码
    drawCount = 400
    ' 初始化数组，存入1到总人数的所有员工序号
    ReDim numArr(1 To totalEmp)
    For i = 1 To totalEmp
        numArr(i) = i
    Next
    
    Randomize
    ' 打乱数组顺序
    For i = totalEmp To 2 Step -1
        rndIndex = WorksheetFunction.RandBetween(1, i)
        ' 交换当前位置和随机位置的数值
        temp = numArr(i)
        numArr(i) = numArr(rndIndex)
        numArr(rndIndex) = temp
    Next
    
    ' 直接取数组前400位就是不重复的中奖序号，示例输出到B列
    Range("B1:B" & drawCount) = WorksheetFunction.Transpose(numArr)
End Sub

使用说明 #

• 两种方案都无需额外引用其他库，复制到你的VBA模块中即可直接运行
• 如果你的员工序号不是从1开始，只需修改Randbetween的上下限或者数组初始化的规则即可
• 生成的不重复序号可以直接对接你原有的员工姓名匹配逻辑，不需要修改原有匹配代码

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