Vba Excel-最快的宏生成数据集

我有一个excel文件，其中包含：

• 在第一个工作表中，有几个计算
• 第二张工作表，其中所有相关数据放在一行中（A2:W2）
• 第三张工作表，其中我将从每一个模拟/计算中收集数据，并将其放在新行（=创建100K模拟数据集）

我现在使用的宏实现了这一点，但是复制的行越多，速度就越慢。我正在寻找一种尽可能干净、快捷的方法。 唯一需要做的事情是：将第二个工作表中的数据范围复制到第三个工作表的第一个自由行上，生成新数据，复制数据，将数据粘贴到第一个自由行上

我现在使用的宏用于10K模拟，但是如果我尝试在一次运行中生成超过100K的数据集，它的速度会非常慢

谢谢你的帮助/建议/提示。请记住，我对这件事很在行：(

Sub Plus10000（）
'
'Plus10000宏
'
Application.ScreenUpdating=False
设x=0
当x<10000时执行此操作
范围（“源数据”）。复制
工作表（“数据”）。范围（“B”和行数。计数）。结束（xlUp）。偏移量（1，0）。粘贴特殊xlPasteValues
x=x+1
环
Application.ScreenUpdating=True
'
端接头

您可以一行一行地进行复制和粘贴，这非常慢，因为每个粘贴操作都需要花费大量时间。但是您可以在一个操作中多次复制和粘贴

Sub Plus10000()
    '
    ' Plus10000 Macro
    '
    Application.ScreenUpdating = False

    Range("SourceData").Copy
    Sheets("Data").Range("B1:B10000").PasteSpecial xlPasteValues

    Application.ScreenUpdating = True
    '
End Sub

---

这将粘贴从第1行到10000行的源范围。

要做的第一件事是避免使用剪贴板

如果您的程序运行1小时，同时您将执行另一项操作，则当用户或其他程序手动更改剪贴板时，Excel宏肯定会崩溃

---

解决问题的唯一方法是编写一个完整的宏来生成数据，而无需使用中间工作表、单元格公式和剪贴板！

您可以尝试在每次迭代时不编写工作表单元格：

Sub Plus10000()
    Const nData As Long = 10000 ' set the number of calculations to be done

    ReDim data(1 To nData, 1 To Range("SourceData").Columns.Count) As Variant ' size you data array to mathc the number of calculations and "source" range

    Dim i As Long, j As Long
    Application.ScreenUpdating = False
    Do While i < nData
        i = i + 1
        Calculate ' have Excel make a new calculation of your workbook formulas
        For j = 1 To UBound(data, 2) ' fill your data current row with "Source" range current values
            data(i, j) = Range("SourceData").Cells(1, j)
        Next
    Loop
    Application.Calculation = xlCalculationManual ' prevent formula recalculation at subsequent "Data" sheet writing
    Sheets("Data").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(data), UBound(data, 2)).Value = data ' fill "data" sheet with data array values in one shot
    Application.Calculation = xlCalculationAutomatic ' set Excel automatic calculation back on
    Application.ScreenUpdating = True
End Sub

Sub Plus10000（）
Const nda As Long=10000'设置要进行的计算数量
ReDim数据（1到数据，1到范围（“源数据”）.Columns.Count）作为变量“将数据数组的大小设置为mathc计算的数量和“源”范围
我和我一样长，我和我一样长
Application.ScreenUpdating=False
趁我不在的时候做
i=i+1
“计算”让Excel重新计算工作簿公式
对于j=1到UBound（数据，2）“用“源”范围当前值填充数据当前行
数据（i，j）=范围（“源数据”）。单元格（1，j）
下一个
环
Application.Calculation=xlCalculationManual“防止在后续“数据”表写入时重新计算公式
工作表（“数据”）。范围（“B”和行数）。结束（xlUp）。偏移量（1，0）。调整大小（UBound（数据），UBound（数据，2））。值=数据“一次使用数据数组值填充”数据“工作表”
Application.Calculation=xlCalculationAutomatic“将Excel自动计算设置回打开状态
Application.ScreenUpdating=True
端接头

感谢您的反馈！这会粘贴1000行，但数据相同。当我逐行工作时，我会得到一个新的结果/模拟，并将其添加到我的数据集中。很遗憾，这将不起作用。@stijngeldof由于粘贴会在原始文件中粘贴特殊值，并且提供的新解决方案也是如此，那么这两个结果应该是相同的，除非您的ori基纳尔代码已更改…如果源数据受数据影响（通过公式），那么除了逐行复制（这需要时间）或考虑其他概念外，没有其他方法（但我们无法告诉您如何执行此操作）。谢谢。我在文件中复制了宏，它运行，但没有将包含数据的行添加到工作表“data”中。在工作表“macro”中，我用信息“Sourcedata”命名了范围。是否需要进行一些调整？请确保在工作表中包含“Sourcedata”时启动宏命名范围是当前激活的范围。此外，在VBA IDE中，使用F8单步执行代码，并使用即时窗口（CTRL键将其弹出）查询相关数据（例如，键入

？i

，然后按return键查看当前

i

变量值。或者在

中，对于j=1到…

循环，键入

？数据（i，j）

并按return键查看当前

数据（i，j）

value，依此类推这些是我的当前时间：行粘贴单元格/行时间行/秒1000 24 00:01:39 10,10 2500 24 00:04:35 9,09 5000 24 00:10:21 8,05 7500 24 00:19:43 6,34 10000 24 00:28:39 5,82我正在使用我的范围“SourceData”所在工作表中的按钮启动宏（需要复制的值）。对于其余部分，我无法使宏适应工作：（它运行，但什么也没有发生）。此外，在VBA IDE中，使用F8逐步完成代码，并使用即时窗口（CTRL键弹出）查询相关数据（例如，键入

？i

，然后按return键查看当前

i

变量值。或者，当j=1进入循环时，键入

？数据（i，j）

，然后按return键查看当前

数据（i，j）

值，依此类推

Sub Plus10000()
    Const nData As Long = 10000 ' set the number of calculations to be done

    ReDim data(1 To nData, 1 To Range("SourceData").Columns.Count) As Variant ' size you data array to mathc the number of calculations and "source" range

    Dim i As Long, j As Long
    Application.ScreenUpdating = False
    Do While i < nData
        i = i + 1
        Calculate ' have Excel make a new calculation of your workbook formulas
        For j = 1 To UBound(data, 2) ' fill your data current row with "Source" range current values
            data(i, j) = Range("SourceData").Cells(1, j)
        Next
    Loop
    Application.Calculation = xlCalculationManual ' prevent formula recalculation at subsequent "Data" sheet writing
    Sheets("Data").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(data), UBound(data, 2)).Value = data ' fill "data" sheet with data array values in one shot
    Application.Calculation = xlCalculationAutomatic ' set Excel automatic calculation back on
    Application.ScreenUpdating = True
End Sub