0

如果 iRow 达到 40,000（请注意，它会导致总共 3,720,000 个公式......），则下面提取的代码可以完美运行。我现在需要为超过 100,000 的 iRow 做同样的事情，如果它完成的话，它是指数级的糟糕......我让 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

4

1 回答 1

2

这对我有用，不到 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 分钟。我的虚拟数据具有 volatileRand()函数，以及基于此函数的另一个函数，跨越 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
于 2013-04-15T21:52:20.867 回答