Question

问题我在表2中有一堆数据。它大约有6k行。我有一些437我想找到。这些在表1（A栏）中规定。对于这些我想复制整行并将其放在表3中。在表2中可以多次找到表1中的值，我需要它们。

我的解决方案我找到了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

使用工作表1中的值，搜索工作表2并将找到的值作为工作表3中的行返回

1 个答案: