Question

我一直试图运行我认为是一个简单的宏两天，并继续遇到这个错误：

＆＃34; Excel无法使用可用资源完成此任务。选择较少的数据或关闭其他应用程序。＆＃34;

我希望从宏中获得20,000次迭代，但错误显示出来的速度要早于此。我认为它会在5,000左右停止。更糟糕的是，我无法挽救我之后得到的东西。我知道在经过多次迭代之后会有大量的数据但却无法填满整张纸。我希望能够运行宏，然后将权重优化到右边。

代码：

Sub Macro1()

    Application.ScreenUpdating = False

    For i = 1 To 20000

        Rows("16:28").Select
        Selection.Copy
        Range("D1048576").End(xlUp).Offset(2, -3).Select
        ActiveSheet.Paste

        Selection.Resize(13, 288).Select
        Selection.Copy

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False

        If i Mod 1000 = 0 Then
            ActiveWorkbook.Save
        End If

    Next i

    Application.ScreenUpdating = True

End Sub

示例数据：

抱歉，我忘记发布工作簿的链接：

https://drive.google.com/open?id=0B0F1yWDNKi2vLWhmUDMtU2xsd00

Answer 1

基于Pauls对您的代码所做的描述，这可能对您有用，它对我自己的测试数据有用：

Sub Quickcopy()
Rows(29).Insert 'Make sure there is a blank row there
With Range("A30:D" & 280000) '280000 = 14 rows multiplied by your number of copies. Change D to however far the columns go
    .Formula = "=IF(A16="""","""",A16)" 'Had to do this otherwise a straight =A16 returned 0 where blanks exist. Note Excel is smart enough to increment the row ref as it goes
    .Copy 'Copy
    .PasteSpecial xlPasteValues 'Paste values
End With
End Sub

Answer 2

您的代码将第16行到第28行的所有数据复制20,000次，并在集合之间复制空行。

此代码执行相同的操作（大约1分钟）：

Option Explicit

Sub copyData()
    Const F_ROW     As Long = 16
    Const F_COL     As Long = 3
    Const SEP       As Long = 2
    Const COPIES    As Long = 20000

    Dim ws As Worksheet, i As Long, t As Double, allR As Long
    Dim srcRng As Variant, lr As Long, lc As Long

    Set ws = Worksheets("Sheet1")
    With ws
        lr = .Cells(.Rows.Count, F_COL + 1).End(xlUp).Row           'last row of data
        lc = .Cells(F_ROW + 1, .Columns.Count).End(xlToLeft).Column 'last col of data

        allR = lr - F_ROW
        srcRng = .Range(.Cells(F_ROW, F_COL), .Cells(lr, lc)).Formula

        Application.Calculation = xlCalculationManual
        For i = 1 To COPIES
            .Range(.Cells(lr + SEP, F_COL), .Cells(lr + allR + SEP, lc)).Formula = srcRng
            lr = lr + allR + SEP
        Next
        Application.Calculation = xlCalculationAutomatic

        .Calculate
        .Cells(1, 1).Activate
    End With
End Sub

注意：

它生成280,028行，包含423列，因此您应将其另存为.xlsb：
- .xlsm：文件大小772 Mb - 保存5分钟，打开3分钟
- .xlsb：文件大小475 Mb - 保存1分钟，打开1分钟

修改

我更改了代码以复制 .Formula 而不是.Value2并遇到了同样的问题：

当i = 1,276（已完成的行：17,882）
时，Excel内存不足
13行X 421列= 5,473个单元格，总计4,979个公式

任务经理：Excel.exe - 内存（私人工作集）：1,833,524 Kb（内存不足）

Application.Calculation = xlCalculationManual无法解决问题

我还尝试运行1000次迭代的代码，然后再手动复制和粘贴20次

内存不足（＆＃34; Excel无法使用可用资源完成此任务......＆＃34;）

最后一次尝试是在Notepad ++中排除流程中的计算

在Excel中：公式 - ＆gt;显示公式（在“公式审计”部分中），然后复制

在记事本中：粘贴公式

复制第16至28行+空白行

多次粘贴行但最终记事本内存不足

宏无法完成，是我的表太大了？

2 个答案: