Question

如果iRow高达40,000，则下面提取的代码工作正常（注意它总共导致3,720,000个公式......）。我现在需要为超过100,000的iRow做同样的事情，并且如果它完成了它会呈指数性的BAD ...我让PC开启了一天以上而且它没有。

Dim iRow    As LongPtr

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

WSD.Range("K2:CZ2").Copy Destination:=WSD.Range("K3:CZ" & iRow)
Application.Calculation = xlCalculationAutomatic
Application.Calculation = xlCalculationManual
WSD.Range("K3:CZ" & iRow).Value = WSD.Range("K3:CZ" & iRow).Value

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

对此问题的任何启示都将非常感激。

配置：Excel 2010 x64 VBA7 WIN64

Answer 1

这对我有用，花了不到30秒：

Sub CopyExample()
Dim iRow As Long
Dim calcState As Long

iRow = 100000
calcState = Application.Calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveSheet.Range("A1:CZ1").Copy Destination:=ActiveSheet.Range("A2:CZ" & iRow)
Application.Calculation = calcState
Application.ScreenUpdating = True
End Sub

你可能想要做除.Copy之外的其他事情，如果这仍然给你带来麻烦。

编辑＃1 尝试使用AutoFill方法而不是Copy方法。对于50,000行，这需要不到2分钟。我的虚拟数据具有易失性Rand()函数，以及基于此函数的另一个函数，来自A1：CZ1的所有列。

Option Explicit

Sub CopyExample2()
Dim iRow As Long
Dim calcState As Long
Dim sourceRange As Range
Dim pasteRange As Range
Dim t As Long

t = Timer
iRow = 100000
calcState = Application.Calculation

'Turn off screenupdating, calculation, etc.'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set sourceRange = ActiveSheet.Range("A1:CZ1")
Set pasteRange = ActiveSheet.Range("A1:CZ" & iRow)
    With sourceRange
        .AutoFill pasteRange
    End With

'Turn on calculation, screenupdating, etc.'
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Debug.Print Timer - t

End Sub

复制目标方法不适用于大量数据/公式

1 个答案: