코드 속도 향상 (한 시트에서 다른 시트로 복사/붙여 넣기)

Question

미리 도움을 주셔서 감사합니다. 셀 값 "True"에 대해 "ClientTradeDetails"라는 시트의 열 O를 검색하는 매크로를 만들었고, 셀 값이 "True"이면 전체 행을 가져 와서 "TrueValues"시트에 붙여 넣습니다. .

작동하지만 극히 느립니다. 보시다시피 필자는 마스터 시트에 65536 행의 데이터를 가지고 있습니다. 복사/붙여 넣기가 문제라고 생각했지만 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 값을 가지고 있다면, 이것들을 모두 배열에 넣고 배열을 다시 워크 시트에 넣습니다. 필요에 따라 인쇄 할 부분을 다시 변경할 수 있습니다.