修改Excel VBA无重复随机数生成子程序以排除指定数字

针对你的需求，我基于你提供的原有代码做了轻量化重构，把通用的随机数生成逻辑封装成独立子过程，方便你按组配置不同的排除规则，代码简洁易读，适合新手修改和维护。

完整代码 #

通用随机数生成子过程 #

' 通用无重复随机数生成过程
' 参数说明：
' targetRange：要填充随机数的单元格范围
' minVal：随机数下限
' maxVal：随机数上限
' excludeNums：需要排除的数字数组（不需要排除则传 Empty）
Private Sub GenerateUniqueRandoms(targetRange As Range, minVal As Long, maxVal As Long, excludeNums As Variant)
    Dim totalCells As Long
    Dim availableNumsCount As Long
    Dim randNum As Long
    Dim cell As Range
    Dim isExcluded As Boolean
    
    ' 清空目标范围
    targetRange.Clear
    totalCells = targetRange.Cells.Count
    
    ' 计算可用唯一数字总数（减去排除的数量）
    availableNumsCount = (maxVal - minVal + 1) - IIf(IsEmpty(excludeNums), 0, UBound(excludeNums) - LBound(excludeNums) + 1)
    
    ' 检查单元格数量是否超过可用数字数
    If totalCells > availableNumsCount Then
        MsgBox "单元格数量超过可用唯一随机数数量，请调整范围或参数", vbExclamation
        Exit Sub
    End If
    
    ' 遍历每个单元格填充随机数
    For Each cell In targetRange
        Do
            ' 生成基础随机数
            randNum = Int((maxVal - minVal + 1) * Rnd + minVal)
            
            ' 检查是否在排除列表中
            isExcluded = False
            If Not IsEmpty(excludeNums) Then
                Dim num As Variant
                For Each num In excludeNums
                    If randNum = num Then
                        isExcluded = True
                        Exit For
                    End If
                Next num
            End If
            
            ' 循环条件：数字被排除 或 当前组内已存在该数字
        Loop While isExcluded Or Application.WorksheetFunction.CountIf(targetRange, randNum) >= 1
        
        ' 填充数字到单元格
        cell.Value = randNum
    Next cell
End Sub

主调用过程（绑定按钮触发） #

Public Sub GenerateAllRandNums()
    ' 初始化随机种子，确保每次生成的随机序列不同
    Randomize
    
    ' 第一组：示例范围A1:A5000，1-20000，无排除
    GenerateUniqueRandoms Range("A1:A5000"), 1, 20000, Empty
    
    ' 第二组：示例范围B1:B5000，1-20000，排除指定数字（这里是100）
    GenerateUniqueRandoms Range("B1:B5000"), 1, 20000, Array(100)
    
    ' 第三组：示例范围C1:C5000，1-20000，无排除（可根据需求修改）
    GenerateUniqueRandoms Range("C1:C5000"), 1, 20000, Empty
    
    ' 第四组：示例范围D1:D5000，1-20000，排除两个指定数字（这里是200和300）
    GenerateUniqueRandoms Range("D1:D5000"), 1, 20000, Array(200, 300)
End Sub

关键说明 #

1. 配置规则：你只需要修改GenerateAllRandNums里的调用参数即可：
   • 第一个参数：指定该组随机数要填充的单元格范围
   • 第二、三个参数：随机数的上下限
   • 第四个参数：用Array(数字1, 数字2...)传入要排除的数字，不需要排除则传Empty
2. 随机种子：新增Randomize语句，避免每次运行生成完全相同的随机序列
3. 边界检查：新增可用数字数量校验，当单元格总数超过（总可用数-排除数）时，会弹出提示并终止，避免死循环
4. 兼容性：完全基于你原有的代码逻辑改造，没有引入复杂语法，新手可以快速理解和调整

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