VBA实现多行匹配数据查询并返回至新工作表的方案求助

When dealing with large datasets, volatile functions like INDEX+MATCH can quickly bog down Excel and cause crashes. Using VBA with in-memory data processing and a dictionary for fast lookups is the way to go here—it’s way more efficient and avoids those performance issues.

Here’s a tailored solution that will:

• Parse your source data (Destination + Part pairs)
• Look up all matching rows in your target dataset (including the Package field)
• Write all complete matches to a new worksheet, with proper row incrementing for each result

Step-by-Step VBA Code #

Sub ExtractMatchingData()
    Dim wsSource As Worksheet, wsData As Worksheet, wsResults As Worksheet
    Dim sourceArr As Variant, dataArr As Variant
    Dim matchDict As Object
    Dim i As Long, j As Long, resultRow As Long
    Dim key As String, splitSource() As String, splitData() As String
    
    ' Set your worksheet names here (adjust to match your workbook)
    Set wsSource = ThisWorkbook.Sheets("Source") ' Sheet with Destination: Part rows
    Set wsData = ThisWorkbook.Sheets("Data") ' Sheet with Destination: Part: Package rows
    Set wsResults = ThisWorkbook.Sheets("Results") ' Sheet to output matches
    
    ' Clear existing results to avoid duplicates
    wsResults.Cells.Clear
    
    ' Read all data into arrays (way faster than looping through cells)
    sourceArr = wsSource.UsedRange.Value
    dataArr = wsData.UsedRange.Value
    
    ' Initialize dictionary to store matches (key = Destination|Part, value = collection of full rows)
    Set matchDict = CreateObject("Scripting.Dictionary") ' Late binding (no reference needed)
    
    ' Populate dictionary with target data
    For i = LBound(dataArr, 1) To UBound(dataArr, 1)
        ' Split the cell content into components (assuming each cell has the full line)
        splitData = Split(Trim(dataArr(i, 1)), " ")
        ' Make sure we have all three values (Destination, Part, Package)
        If UBound(splitData) >= 2 Then
            key = splitData(0) & "|" & splitData(1) ' Combine Destination and Part as unique key
            ' Add the full row data to the dictionary's collection for this key
            If Not matchDict.Exists(key) Then
                matchDict.Add key, New Collection
            End If
            matchDict(key).Add dataArr(i, 1) ' Add the complete row text
        End If
    Next i
    
    ' Now extract matches for each source entry and write to results
    resultRow = 1 ' Start writing results at row 1
    For i = LBound(sourceArr, 1) To UBound(sourceArr, 1)
        ' Split source cell into Destination and Part
        splitSource = Split(Trim(sourceArr(i, 1)), " ")
        If UBound(splitSource) >= 1 Then
            key = splitSource(0) & "|" & splitSource(1)
            ' Check if there are matches in the dictionary
            If matchDict.Exists(key) Then
                ' Write all matching rows to results
                For j = 1 To matchDict(key).Count
                    wsResults.Cells(resultRow, 1).Value = matchDict(key)(j)
                    resultRow = resultRow + 1 ' Increment row for next match
                Next j
            Else
                ' Optional: Write a note if no matches found
                wsResults.Cells(resultRow, 1).Value = "No matches found for: " & sourceArr(i, 1)
                resultRow = resultRow + 1
            End If
        End If
    Next i
    
    ' Auto-fit columns in results sheet for readability
    wsResults.Columns(1).AutoFit
    
    MsgBox "Matching data extraction complete!", vbInformation
End Sub

How to Use This Code #

1. Open your Excel workbook and press Alt + F11 to open the VBA Editor.
2. Right-click your workbook in the Project Explorer > Insert > Module.
3. Paste the code above into the module.
4. Adjust the worksheet names (wsSource, wsData, wsResults) to match your actual sheet names.
5. Press F5 to run the macro, or assign it to a button for easier access.

Key Benefits #

• Speed: By reading all data into arrays first, we avoid slow cell-by-cell operations. The dictionary allows O(1) lookups, making this scalable even for very large datasets.
• Stability: No more Excel crashes from overloading with volatile functions.
• Flexibility: The code includes optional handling for entries with no matches, and you can easily modify it to output specific fields instead of the full row if needed.

Notes #

• This assumes your source and target data are stored in the first column of their respective sheets. If your data is in a different column, adjust the column index (e.g., dataArr(i, 2) for column B).
• The code uses late binding for the dictionary, so you don’t need to enable any references—just paste and run.

内容的提问来源于stack exchange，提问作者Chemdawg