尝试搜索包含匹配数据的行以从值列表移动到新工作表 - 不起作用

Question

我试图将工作表的每一行复制到新工作表，其中特定列（“G”）中的值与不同工作表列（“A”）上的值列表匹配，但随后漫长的等待结束以复制一行结束，大概是最后找到的行。

这是我正在使用的代码：

Sub FindData()
'Run code to grab all sample data matching to chassis numbers

Dim s As Integer
Dim x As Integer
Dim NARow As Integer
NARow = 2

For s = 2 To 2920
    For x = 2 To 24842
        If Sheets("Serials").Cells(s, 1).Value = Sheets("RawData").Cells(x, 7).Value Then
            Sheets("RawData").Rows(x).EntireRow.Copy
            Sheets("FinalData").Range("A" & NARow).PasteSpecial Paste:=xlValues
            NARow = NARow + 1
        End If
    
    Next x
Next s
End Sub

Answer 1

将其编写为通用程序。使用两个表上的最后一行，并在找到匹配项时退出内循环。

Sub Main()
    Call PopulateMatchedData(Sheets("Serials"), 1, Sheets("RawData"), 7, Sheets("FinalData"))
End Sub

Sub PopulateMatchedData(ByRef wsSheet1 As Worksheet, ByVal iColSheet1 As Integer, _
                        ByRef wsSheet2 As Worksheet, ByVal iColSheet2 As Integer, _
                        ByRef wsDestination As Worksheet, Optional DataStartRow As Integer = 2)
'Compares two work sheets for a value.  If iCol_ matches resulting row in wsSheet2 is moved to wsDestination

    Dim oCurRowSheet1 As Long           ' Row Counter for Sheet 1
    Dim oCurRowSheet2 As Long           ' Row Counter for Sheet 2
    Dim oCurRowDestination As Long      ' Row Counter for destination sheet
    oCurRowDestination = DataStartRow
    
    ' Loops for each sheet start with offset provided defaulting to row 2, until the last used row of that sheet.
    For oCurRowSheet1 = DataStartRow To wsSheet1.Cells(wsSheet1.Rows.Count, 1).End(xlUp).Row
        For oCurRowSheet2 = DataStartRow To wsSheet2.Cells(wsSheet2.Rows.Count, 1).End(xlUp).Row
            If wsSheet1.Cells(oCurRowSheet1, iColSheet1).Value = wsSheet2.Cells(oCurRowSheet2, iColSheet2).Value Then
                'On Match Copy entire sheet2 row into Destination Sheet
                wsSheet2.Rows(oCurRowSheet2).EntireRow.Copy wsDestination.Rows(oCurRowDestination)
                oCurRowDestination = oCurRowDestination + 1
                Exit For    ' Leave the inner for loop if Match was found
            End If
        Next
    Next
End Sub