使用值，搜索片2和在片材3

Question

問題返回找到的值作爲行我有一個樁在片2的數據這是圍繞6K行。 我有一些437我想找到。這些在表1（A欄）中規定。 對於這些我想複製整行並將其放在工作表3中。 工作表1中的值可以在工作表2中多次找到，我需要它們全部。

我的解決方案我發現VBA搜索它所有。但它停在437.

Public Sub findfak() 

Dim lastRowS1 As Long 
Dim lastRowS2 As Long 
Dim lastRowS5 As Long 
Dim i As Long 
Dim j As Long 
Dim tempS1 As Long 
Dim temps2 As Long 
Dim tempRow As Long 

lastRowS1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row 
lastRowS2 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row 

Application.ScreenUpdating = False 

    For i = 2 To lastRowS1 
     tempS1 = Sheet1.Cells(i, 1).Value 

     If Not IsError(Application.Match(tempS1, Sheet2.Range("A:A"), 0)) Then 
      lastRowS5 = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row 
      Sheet2.Rows(i).EntireRow.Copy Destination:=Sheet5.Rows(lastRowS5 + 1) 
     End If 

    Next i 

Application.ScreenUpdating = True 
End Sub 

Answer 1

試試這個。

Sub findfak() 

Dim lastRowS1 As Long 
Dim lastRowS2 As Long 
Dim lastRowS5 As Long 
Dim i As Long 
Dim j As Long 
Dim tempS1 As Variant 
Dim temps2 As Long 
Dim tempRow As Long 

Dim ws1 As Worksheet 
Dim ws2 As Worksheet 
Dim ws3 As Worksheet 

'change sheets as necessary 
Set ws1 = WorkSheets("Sheet5") 
Set ws2 = WorkSheets("Sheet6") 
Set ws3 = WorkSheets("Sheet2") 

lastRowS1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row 
lastRowS2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row 

Application.ScreenUpdating = False 

For i = 2 To lastRowS1 

    tempS1 = ws1.Cells(i, 1).Value 

    For j = 2 To lastRowS2 

     If ws2.Cells(j, 1) = tempS1 Then 
      lastRowS5 = ws3.Cells(Rows.Count, 1).End(xlUp).Row 
      ws2.Rows(j).EntireRow.Copy Destination:=ws3.Rows(lastRowS5 + 1) 
     End If 

    Next j 

Next i 

Application.ScreenUpdating = True 

End Sub