0

以下の抽出されたコードは、iRow が最大 40,000 の場合に完全に機能します (合計 3,720,000 式になることに注意してください...)。100,000 を超える iRow に対しても同じことを行う必要があり、終了した場合は指数関数的に悪いです... PC の電源を 1 日以上オンにしたままにしましたが、そうではありませんでした。

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。

編集 #1AutoFillメソッドの代わりにメソッドを使用しようとしています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
于 2013-04-15T21:52:20.867 に答える