循环遍历工作簿中的列匹配数据并返回一个值

Question

我一直在尝试将以下代码改编为 遍历工作表 1 的 A 列，并针对 A 列中的每个值在整个工作簿中搜索其匹配值（将在另一张工作表中的 A 列中找到）。找到匹配项后，返回在同一行但从 F 列找到的值。

Sub Return_Results_Entire_Workbook()
    searchValueSheet = "Sheet2"
    searchValue = Sheets(searchValueSheet).Range("A1").Value
    returnValueOffset = 5
    outputValueSheet = "Sheet2"
    outputValueCol = 2
    outputValueRow = 1

    Sheets(outputValueSheet).Range(Cells(outputValueRow, outputValueCol), Cells(Rows.Count, outputValueCol)).Clear
    wsCount = ActiveWorkbook.Worksheets.Count

    For I = 1 To wsCount
        If I <> Sheets(searchValueSheet).Index And I <> Sheets(outputValueSheet).Index Then
            'Perform the search, which is a two-step process below
            Set Rng = Worksheets(I).Cells.Find(What:=searchValue, _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
                
            If Not Rng Is Nothing Then
                rangeLoopAddress = Rng.Address
            
                Do
                    Set Rng = Sheets(I).Cells.FindNext(Rng)
                    Sheets(outputValueSheet).Cells(Cells(Rows.Count, outputValueCol).End(xlUp).Row + 1, outputValueCol).Value = Sheets(I).Range(Rng.Address).Offset(0, returnValueOffset).Value
                Loop While Not Rng Is Nothing And Rng.Address <> rangeLoopAddress
            End If
        End If
    Next I
End Sub

上面的代码有效，但仅适用于 Sheet1 上的第一行数据。

任何帮助将不胜感激！

Answer 1

您可以创建一个数组数组，其中主数组的每个索引都是每个工作表中的数据集 A:F：

Sub test()
Dim WK As Worksheet
Dim LR As Long
Dim i As Long
Dim j As Long
Dim MasterArray() As Variant
Dim WkArray As Variant

'create master aray
ReDim MasterArray(1 To ThisWorkbook.Worksheets.Count - 1) 'As many indexes as worksheets -1 (because master sheet does not count)
i = 1

For Each WK In ThisWorkbook.Worksheets
    If WK.Name <> "Hoja1" Then 'exclude master sheet witch search values
        LR = WK.Range("A" & WK.Rows.Count).End(xlUp).Row 'last non-blank row
        WkArray = WK.Range("A1:F" & LR).Value 'take all values in A:F to singlearray
        MasterArray(i) = WkArray
        Erase WkArray
        i = i + 1
    End If
Next WK

'now in Master array you have in each index all the values
' as example, if you call MasterArray(1)(1, 1) it will return cell value A1 from first worksheet

Set WK = ThisWorkbook.Worksheets("Hoja1") 'master sheet witch search values

With Application.WorksheetFunction
    LR = WK.Range("A" & WK.Rows.Count).End(xlUp).Row 'last non-blank row
    For i = 1 To LR Step 1 'for each row in master sheet until last non blank
        For j = 1 To UBound(MasterArray) Step 1 'for each dataset in masterarray
            WkArray = Application.Transpose(Application.Index(MasterArray(j), , 1)) 'first column of dataset (A column)
            
            If IsError(Application.Match(WK.Range("A" & i).Value, WkArray, 0)) = False Then 'if value exists get F
                WK.Range("B" & i).Value = .VLookup(WK.Range("A" & i).Value, MasterArray(j), 6, 0)
                Erase WkArray
                Exit For
            End If
            
            Erase WkArray
        Next j
    Next i
End With

Erase MasterArray
Set WK = Nothing

End Sub

该代码首先创建名为MasterArray 的主数组。然后它循环遍历 Master Sheet 中 A 列的每个值（在我的示例中名为 Hoja1）并检查每个子数组中是否存在该值。如果是，则返回数据集中的 F 列并继续循环。

执行代码后我得到这个输出：

注意值 2 不返回任何内容，因为它不存在于任何其他工作表中。