Question

以下子句在其循环中有一个复制语句，需要2秒才能在Excel 2013中执行。因此，对于20次迭代，这将超过40秒。我已经尝试了所有常用的最佳选择，例如禁用事件和屏幕更新。有没有人有同样的问题？

typeid

Answer 1

我使用提示进行了一些修改

通过明确减少Excel与代码之间传输数据的次数来优化代码。不是一次循环一个单元来获取或设置值，而是使用包含二维数组的变量来获取或设置一行中整个单元格范围内的值，以根据需要存储值。

来自此article我修改了您的代码：

Sub TEST_SUB(surface)
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    Worksheets("Sheet3").Activate
    ActiveSheet.DisplayPageBreaks = False

    Sheets("Sheet3").Range("A4:Z400").ClearContents    

    y = 4   'y is the row on sheet3 where we want to paste
    For x = 4 To 20 'x is the current row from which we want to copy
    ' Decide if to copy based on whether the value in col 10 matches the parameter Surface
        ThisValue = Sheets("Tests_Master").Cells(x, 10).value
        If ThisValue = surface Or x = 4 Then
            R1 = "A" + CStr(x) + ":K" + CStr(x) 'Range to copy from: row X columns 1-10

            'Is faster use an array to store a range to copy after
            rangeToCopy = Sheets("Tests_Master").Range(R1)
            Sheets("sheet3").Range("A" + CStr(y) + ":K" + CStr(y)) = rangeToCopy

            'This next statement taks about 2 seconds to execute ! WHY????
            'Sheets("Tests_Master").Range(R1).Copy Destination:=Sheets("sheet3").Range("A" + CStr(y))
            y = y + 1

        End If

    Next x

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

P.S。：对不起我的英文

内部循环中的Excel VBA复制操作非常慢

1 个答案: