2

ワークブック内の 1 つのスプレッドシートから他の 160 のスプレッドシートに大量のデータをコピーする作業を行っています。現在、操作を完了するのに十分なリソースがないため、Excel (2013) でエラーが発生します。

私の目標は、シート 4 の範囲 V13:XI1150 のデータをシート 5 ～ 160 にコピーすることです。コードが格納されている範囲を分割して (変数 rng1 と rng2 を参照)、10 個のワークシートをグループ化してみました (ただし、これはほとんど効果がないことはわかっています)。

このデータを正常にコピーできるように、ここで作業しているコードを合理化する方法はありますか?

前もって感謝します。

Sub copypaste()

'''''''''Globals'''''''''''''

Dim j As Long 'Loop control variable
Dim sheetstart As Integer 'starting sheet variable
Dim sheetend As Integer 'ending sheet variable
Dim rng1 As Range 'range to copy
Dim rng2 As Range 'Second range

Application.Calculation = xlCalculationManual 'Sets manual calculation
Application.ScreenUpdating = False 'Turns off screen updating


sheetstart = 5 'first sheet to copy over in loop
sheetend = 15 'last sheeet to copy over in loop

With Sheets(4) 'Selects the 4th sheet
    Set rng1 = Range("V13:LO1150") 'Stores first half of data in rng
    Set rng2 = Range("LP13:XI1150") 'Stores second half of data in rng
End With


For j = 1 To 16 'loops through all groups of 10 sheets
    copypaste10 rng1, sheetstart, sheetend 'calls copypaste10 function
    copypaste10 rng2, sheetstart, sheetend 'calls copypaste10 function
    sheetstart = sheetstart + 10 'increments to next 10 sheets
    sheetend = sheetend + 10 'increments to next 10 sheets

    Next

Application.Calculation = xlCalculationAutomatic 'Sets auto calculation
Application.ScreenUpdating = True 'Turns on screen updating


End Sub


Public Function copypaste10(rng As Range, sstart As Integer, sstop As Integer)
'''''''''Locals'''''''''''''
    Dim i As Long 'Loop control
    Dim WS As Worksheet 'worksheet being worked on
    Dim ArrayOne() As String 'Array of sheets we are working on

    ReDim ArrayOne(sstart To sstop) 'Array of sheets

''''''''''Calcuations'''''''''''''
    For i = sstart To sstop
        ArrayOne(i) = Sheets(i).Name
    Next

    For Each WS In Sheets(ArrayOne)
        WS.Rows(2).Resize(rng.Count).Copy
        rng.Copy Destination:=WS.Range("v13")
        Next WS


End Function
4

2 に答える 2

1

次のコードで簡単なテストを実行したところ、問題なく実行されました。

Sub test()

    Application.ScreenUpdating = False

    Dim rng As Range
    Set rng = Worksheets("Sheet1").Range("V13:XI1150")
    rng.Copy

    For i = 2 To 161
        Sheets(i).Select
        Range("V13").Select
        ActiveSheet.Paste
    Next

    Application.ScreenUpdating = True

End Sub

テスト セルには静的データのみがあり、数式はありませんでした。自動計算をオンに戻すと、特にセル内での複雑な計算の場合、システム リソースに大きな打撃を与えるため、違いが生じる可能性があります。

于 2013-10-11T17:37:01.350 に答える
0

ループで行っているのは余分なコピーである可能性があります。

WS.Rows(2).Resize(rng.Count).Copy

そのコピーは、どこにも貼り付けていないように見えても、メモリに保存されます (正直に言うと、関数を終了した後、または必要に応じてクリップボードがクリアされるかどうかはわかりません)。

それにもかかわらず、これは、範囲の原点に数式がない場合の代替ソリューションです。宛先は常に同じであり、元の範囲は同じディメンション (開始点が異なるだけ) であるため、コピー/貼り付けをすべて一緒に回避できます。

For Each WS In Sheets(ArrayOne)
    WS.Range("V13:LO1150") = rng.Value
Next WS

繰り返しますが、値のみが宛先シートにコピーされることに注意してください

* --編集-- *

数式が必要な場合は に変更できますが.Value、.Formulaこれにより、宛先シートの相対参照ではなく、元のシートを参照する数式が「貼り付け」られることに注意してください。また、マクロ ( を実行する前に自動計算をオフにし、最後に ( )Application.Calculation = xlCalculationManualを計算するか計算をオンにするか、または.Application.Calculation =xlCalculationAutomaticApplication.Calculate

于 2013-10-11T18:01:09.277 に答える