Excel VBAのコピー範囲は1,048,576行後の新しいシートになります

Question

VBAで非常に簡単なマクロを書き、一連の変数を更新し、更新した値をコピーして新しいシートに貼り付けました。問題は、ボリュームが現在圧倒されているため、Excelで1,048,576行の制限に達し、コードがクラッシュすることです。

行制限に達するたびに、スクリプトは完全に実行されるまでセルを新しいシート（「FinalFile2」、「FinalFile3」など）にコピーし始めます。

Sub KW() 
' 
' Exact KWs 
' 
Dim i, j, LastRow As Long 
Dim relativePath As String 

i = 2 
j = 2 

'LastRowValue' 
Sheets("Output").Select 
LastRow = Rows(Rows.Count).End(xlUp).Row - 1 

'Clean final output' 
    Sheets("FinalFile").Select 
    Range("A2").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.ClearContents 
    Range("A1").Select 

'Set Variables in Variables sheet' 

Do 

'Var 1' 
    Sheets("Names").Select 
    Range("A" & i).Select 
    Selection.Copy 
    Sheets("Variables").Select 
    Range("A2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

'Var 2' 
    Sheets("Names").Select 
    Range("B" & i).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Variables").Select 
    Range("B2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

'Var 3' 
    Sheets("Names").Select 
    Range("C" & i).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Variables").Select 
    Range("C2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

'Var 4' 
    Sheets("Names").Select 
    Range("D" & i).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Variables").Select 
    Range("D2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 


'Var 5' 
    Sheets("Names").Select 
    Range("E" & i).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Variables").Select 
    Range("E2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 


    'Var 6' 
    Sheets("Names").Select 
    Range("F" & i).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Variables").Select 
    Range("F2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

    'Var 7' 
    Sheets("Names").Select 
    Range("G" & i).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Variables").Select 
    Range("G2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 


    'Var 8' 
    Sheets("Names").Select 
    Range("H" & i).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Variables").Select 
    Range("H2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 



    'Var 9' 
    Sheets("Names").Select 
    Range("I" & i).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Variables").Select 
    Range("I2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 



    'Var 10' 
    Sheets("Names").Select 
    Range("J" & i).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Variables").Select 
    Range("J2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 



    'Var 11' 
    Sheets("Names").Select 
    Range("K" & i).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Variables").Select 
    Range("K2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 


'Copy and Paste' 

    Sheets("Output").Select 
    Range("A2:AP2").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 
    Sheets("FinalFile").Select 
    Range("A" & j).Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

'update counters' 

i = i + 1 
j = j + LastRow 

'end of loop condition' 

Sheets("Names").Select 

Loop Until IsEmpty(Cells(i, 1)) 



End Sub 

Answer 1

あなたは

j = j + lastRow 
If j = 1048576 Then j = 2 

を追加することができますが、あなたは間違いなくこのコードをクリーンアップする必要があります。 .selectionsは、このようなことをするための非常に遅い方法です。 thisを参照して回避してください。.Copy & .Paste=を使用して、ターゲットセルをソースの値に設定するだけです。これはまた、多くの時間を節約する。

編集：そして、間違いなくここにあなたのコードを改善するための方法をいくつかのヒントがある@arcadeprecinct

Answer 2

により投稿されたリンクを見てみましょう。私は元の質問に私のコメントで述べた問題に入るが、単にコードの特定の部分に集中しておりません。

1. はSelection秒を削除します。

   Sheets("Names").Select 
   Range("A" & i).Select 
   Selection.Copy 
   Sheets("Variables").Select 
   Range("A2").Select 
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
   :=False, Transpose:=False 
   

   は、このようなあなたのシートを参照するために

   Sheets("Names").Range("A" & i).Copy 
   Sheets("Variables").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
   :=False, Transpose:=False 
   

2. 使用変数を次のようになります。一般的なパターンは、あなたがあなたのケースでは

   something.Dosomething 
   

   を使用する代わりに

   something.Select 
   Selection.Dosomenthing 
   

   であります：

   Dim nameSheet as Worksheet 
   Dim varSheet as Worksheet 
   Dim finalSheet as Worksheet 
   
   Set nameSheet = Sheets("Names") 
   Set varSheet = Sheets("Variables") 
   Set finalSheet = Sheets("FinalFile") 
   

   今、あなたは

   finalSheet.Range(...).Pastespecial ... 
   

   を使用して、スペース

3. を使い果たしたら1で隣同士に1セルをコピーしないでくださいSet finalSheet = Sheets("FinalFile2")を使用することができます。 AiをA2にコピーし、次にBi〜B2にコピーしています。範囲Ai:KiをA2:K2にコピーしてください（この点は表示されません）。

4. 不要な場合は、Copyを使用しないでください。代わりに

   someRange.Copy 
   someOtherRange.PasteSpecial Paste:=xlPasteValues 
   

   のとき、あなたは（設定が完了した後Trueに設定）Application.Screenupdating = Falseを使用して無効にScreenupdating

   someOtherRange.Value = someRange.Value 
   

   （サイズが同じであることを確認してください）

5. を使用することができます多くの挿入をしています。それはマクロをたくさん高速化できます。あなたの実際の質問に関しては

6. 、トムが示唆するように行う、シートまで、この実行を行いますどのくらい

   If j > 1048576 Then 
       j = 2 
       Set finalSheet = Sheets("FinalFile2") 'maybe create the new sheet at this point 
   End If