VBA 루프 - 단 하나의 결과

Question

이 자습서를 사용하여 VBA 루프를 작성하여 열의 값을 검색하고 기준 값을 가진 모든 행을 가져옵니다.

https://www.youtube.com/watch?v=QOxhRSCfHaw

이 실행되지만 실행하는 데 약 5 분 정도 소요되며 I 수천을 받고되어야 할 때 결국 난 단지 한 결과 (행)을 얻는다.

Sub finddata() 

'1.Declare Variables 
'2.Find Records that match criteria and paste them into new worksheet 

Dim customcode As String 
Dim finalrow As Long 
Dim i As Long 

customcode = Sheets("Sheet2").Range("A1").Value 
finalrow = Sheets("Raw Data").Range("A252800").End(xlUp).Row 

For i = 1 To finalrow 

If Cells(i, 46) = customcode Then 
Range(Cells(i, 1), Cells(i, 102)).Copy 
Worksheets("Sheet1").Range("A1").PasteSpecial 
End If 

Next i 

End Sub 

모든 도움을 주시면 감사하겠습니다.

Answer 1

어레이를 사용해보십시오.

Sub finddate() 

Dim dataRng As Range 
Dim origData, newData 
Dim i As Long, j As Long, k As Long 
Dim customcode As String 

customcode = Sheets("Sheet2").Range("A1").Value 

With ThisWorkbook.Worksheets("Raw Data") 
    Set dataRng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 102).End(xlUp)) 
End With 

origData = dataRng.Value 
ReDim newData(1 To UBound(origData, 1), 1 To UBound(origData, 2)) 

j = 1 
For i = 1 To UBound(origData, 1) 
    If origData(i, 46) = customcode Then 
     For k = 1 To UBound(origData, 2) 
      newData(j, k) = origData(i, k) 
     Next 
     j = j + 1 
    End If 
Next 

With ThisWorkbook.Worksheets("Sheet1") 
    .Range(.Cells(1, 1), .Cells(j, 102)) = newData 
End With 

End Sub 

사용