如何让Excel VBA生成无重复的随机抽样结果？

你的代码直接用Rnd生成随机数时没有做去重校验，所以会出现重复值；另外大量依赖Select和ActiveCell的操作不仅效率低，还容易因单元格选中状态变化导致错误。以下是优化后的代码，能生成无重复的随机样本：

Sub Randomise_data()
    Dim ws As Worksheet
    Dim totalNum As Long, sampleNum As Long
    Dim rngOutput As Range
    Dim usedNums As Collection
    Dim randomNum As Long
    
    ' 指定操作的工作表，可替换为具体表名如Sheets("Sheet1")
    Set ws = ActiveSheet
    
    ' 清除F4及以下的旧数据
    ws.Range("F4", ws.Cells(ws.Rows.Count, "F").End(xlUp)).ClearContents
    
    ' 获取E2的总数和F2的样本数
    totalNum = ws.Range("E2").Value
    sampleNum = ws.Range("F2").Value
    
    ' 校验输入合理性：样本数不能超过总数
    If sampleNum > totalNum Then
        MsgBox "样本数量不能大于总数！"
        Exit Sub
    End If
    
    ' 用集合存储已生成的随机数，利用Key唯一性避免重复
    Set usedNums = New Collection
    
    ' 设置输出起始单元格为F4
    Set rngOutput = ws.Range("F4")
    
    ' 循环生成无重复随机数
    Do While usedNums.Count < sampleNum
        ' 生成1到totalNum之间的随机整数
        randomNum = Int(totalNum * Rnd) + 1
        
        ' 尝试将随机数加入集合，重复的Key会触发错误，直接跳过
        On Error Resume Next
        usedNums.Add randomNum, Key:=CStr(randomNum)
        On Error GoTo 0
        
        ' 若成功加入集合（即数不重复），写入单元格并下移输出位置
        If usedNums.Count = rngOutput.Row - 3 Then
            rngOutput.Value = randomNum
            Set rngOutput = rngOutput.Offset(1, 0)
        End If
    Loop
    
    ' 可选：将光标定位回F2
    ws.Range("F2").Select
End Sub

关键改进说明 #

• 去重逻辑：借助Collection的Key唯一性特性，重复的随机数无法被添加到集合中，从而保证生成的样本无重复
• 代码稳定性：去掉所有Select/ActiveCell操作，直接通过对象引用操作单元格，避免因手动选中其他单元格导致的代码异常
• 输入校验：新增样本数与总数的合理性检查，避免出现逻辑矛盾的情况

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