コードを高速化する必要があります（1枚のシートから別のシートにコピー/貼り付け）

Question

ありがとうございました。セル値が "True"の場合は "ClientTradeDetails"というシートの列Oを検索するマクロを作成し、セル値が "True"の場合はその行全体を取り出して "TrueValues"というシートに貼り付けます。

これは動作しますが、非常に遅いです。ご覧のとおり、マスターシートに65536行分のデータがあります。 Copy/Pasteが問題だと思っていましたが、Copyメソッドを避けるためにこれを変更する方法はわかりません。どんな助け？

Sub MoveTrue() 

Sheets("ClientTradeDetails").Select 

Dim tfCol As Range, Cell As Object 

    Set tfCol = Range("O2:O439050") 'Substitute with the range ' 

    For Each Cell In tfCol 

     If Cell.Value = "True" Then 
      Cell.EntireRow.Cut 
      Sheets("TrueValues").Select 
      ActiveSheet.Range("A65536").End(xlUp).Select 
      Selection.Offset(1, 0).Select 
      ActiveSheet.Paste 
     End If 

    Next 

End Sub 

Answer 1

これは、あなたが探していたよりも少し複雑かもしれませんが、それははるかに効率的にデータをコピーして貼り付けるよりも動作します。このマクロは、本質的には、レコードの数を見つけるん

Sub GetTrueValues() 

Dim ws As Worksheet 
Dim arr() As Variant 
Dim arrFound() As Variant 
Dim arrOut() As Variant 

Dim i As Long 
Dim j As Long 
Dim k As Long 

Dim lConst As Long: lConst = 15 ' For the O column 

Set ws = ActiveWorkbook.Sheets("SheetName") 
arr() = ws.UsedRange.Value 

For i = LBound(arr()) To UBound(arr()) 
    If arr(i, lConst) = "True" Then 
     k = k + 1 
     ReDim arrFound(1 To k) 
     arrFound(k) = i 
    End If 
Next 

ReDim arrOut(1 To k, 1 To UBound(arr(), 2)) 
For i = 1 To UBound(arrFound()) 
    For j = LBound(arr()) To UBound(arr(), 2) 
     arrOut(i, j) = arr(arrFound(k), j) ' Using the previously stored integer, 
              ' retrieve the records of interest. 
    Next 
Next 

ActiveWorkbook.Sheets.Add 
ActiveSheet.Range("A1").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)).Value = arrOut() 

End Sub 

何その値がtrueの場合は、これらをすべて配列に入れ、配列をワークシートに戻します。必要に応じてプリントアウトする部分を変更することができます。