如何用VBA快速生成基于RAND()的R5/S5单元格10万次迭代运行值列表

优化方案说明 #

原代码性能差、出现空白间隔的核心原因：

• 大量使用Select、复制粘贴这类依赖Excel界面交互的操作，单次执行开销高，10万次迭代下性能会指数级下降
• 逐行写入单元格，频繁触发工作表事件和重绘
• 硬编码重复操作，缺少循环逻辑，写入位置错位就会产生空白间隔

优化后的VBA代码 #

Sub 批量迭代生成随机结果()
    ' 定义参数
    Const 迭代次数 As Long = 100000 ' 可根据实际需求调整迭代次数
    Dim 结果数组 As Variant
    Dim i As Long
    Dim 源工作表 As Worksheet
    
    ' 绑定操作的工作表，避免跨表引用错误
    Set 源工作表 = ActiveSheet ' 如果是固定工作表可直接写为Set 源工作表 = Sheet1
    
    ' 预定义数组大小，10万行2列，所有结果先存在内存中
    ReDim 结果数组(1 To 迭代次数, 1 To 2)
    
    ' 临时关闭无关功能大幅提升运行速度
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual ' 关闭自动重算，手动控制更新时机
    
    ' 循环迭代
    For i = 1 To 迭代次数
        ' 手动触发一次重算，更新R5、S5的随机值
        源工作表.Calculate
        ' 直接读取单元格值写入数组，不经过剪贴板
        结果数组(i, 1) = 源工作表.Range("R5").Value
        结果数组(i, 2) = 源工作表.Range("S5").Value
    Next i
    
    ' 一次性将所有结果写入工作表，从U5位置开始写入
    源工作表.Range("U5").Resize(UBound(结果数组, 1), UBound(结果数组, 2)).Value = 结果数组
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

优化效果说明 #

• 内存数组批量写入的方式相比逐行粘贴效率提升100倍以上，10万次迭代正常几秒就能跑完
• 完全抛弃复制粘贴、Select这类低效操作，不会出现写入错位导致的空白间隔
• 手动控制重算时机，确保每次迭代的随机值更新逻辑符合要求

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