VBA 从查找列表中返回所有匹配项答案

【问题标题】：VBA to return all matches from a lookup listVBA 从查找列表中返回所有匹配项
【发布时间】：2020-06-14 16:28:02
【问题描述】：

我正在尝试实现一个 VBA 方法来搜索名称列表并从提供的列表中返回匹配的所有实例。我需要返回的数据在 A2:E11 中。这可能要大得多，我包含的示例数据比我实际尝试使用的数据简单得多。我要查找的值在 H3:H6 范围内。如果要查找更多查找值，这也可能更大。我试图得到的输出在 J3:N6 中。目前我正在使用一个 VBA 脚本，它一次只能处理一个查找值。如果我只有一个查找值，该方法效果很好。我想知道我必须对下面的脚本进行哪些更改才能使其适用于我正在尝试做的事情。同样，我试图返回查找列表的所有匹配项并将该数据复制到“输出”范围。我是 VBA 新手，但我相信这是可能的。过去，有一个类似的问题，我使用索引匹配数组来返回匹配项的第 n 次出现。这种方法现在对我不起作用，因为我尝试使用它的数据集太大并且计算时间太长。

任何建议将不胜感激！谢谢大家！

'1. declare variables
'2. clear old search results
'3. find records that match criteria and paste them

'https://www.youtube.com/watch?v=QOxhRSCfHaw#action=share

Dim name As String 'What you are trying to match to
Dim finalrow As Integer 'Simply a final row helper
Dim i As Integer 'Row counter

Sheets("Sheet1").Range("R3:V15").ClearContents 'Clearing the previous output

name = Sheets("Sheet1").Range("P3").Value
finalrow = Sheets("Sheet1").Range("A1000").End(xlUp).Row 'This is simply going to a cell way below the data and searching upewards to get the final row

For i = 3 To finalrow 'Row your data starts
    If Cells(i, 1) = name Then
        Range(Cells(i, 1), Cells(i, 5)).Copy
        Range("R100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
        End If
Next i

Range("P3").Select

End Sub

【问题讨论】：

那么，我们可以根据您发布的图片提供我们的建议或一些代码来帮助您吗？我的意思是，我们是否可以推断出“查找列表”应该存在于 H:H 列中，从第三行开始？在您的代码中，您使用 P3 单元格中的值...
是的！一些代码肯定是我正在寻找的，但建议也将不胜感激。我提供的图片包括我的示例数据集、我想要实现的输出以及我目前拥有的输出。我目前拥有的代码是用于黑线的“右侧”。我试图在我的数据中找到的查找值在 H:H 中，从第 3 行开始回答您的问题。
好的。我会准备一个答案。对于大范围，使用数组并使所有过程在内存中进行的最快方法......我会在这方面给出答案。
谢谢！！！！如果我的问题还有什么需要澄清的，请告诉我。最快的方法肯定会很好。

标签： excel vba match lookup

【解决方案1】：

请测试下一个代码：

Sub testMultipleLookup_NamesSearch()
 Dim sh As Worksheet, lastRow As Long, arr As Variant, arrLookUp As Variant
 Dim arrFin As Variant, i As Long, j As Long, t As Long, k As Long

 Set sh = ActiveSheet 'you can use here your sheet to be processed
 lastRow = sh.Range("A" & Rows.Count).End(xlUp).row
 arr = sh.Range("A2:E" & lastRow).Value 'put in an array the range to be processed
 ReDim arrFin(1 To 5, 1 To UBound(arr, 1)) 'the initial dimensions able to keep the maximum occurrences
                                           'it is reversed in terms of rows and columns, because only the last dimension can be changed at the end

 k = k + 1 'initialize the variable or arrFin (final) rows
 For t = 1 To 5
    arrFin(t, k) = arr(1, t) 'load the head of the table
 Next t
 arrLookUp = sh.Range("H3:H" & sh.Range("H" & Rows.Count).End(xlUp).row).Value 'Put in an array the Lookup_Names

 For i = 2 To UBound(arrLookUp, 1) 'start iteration of Lookup_Names
    For j = 1 To UBound(arr, 1)    'iterate between the array to be processed
        If arrLookUp(i, 1) = arr(j, 1) Then
            k = k + 1
            For t = 1 To 5
                arrFin(t, k) = arr(j, t) 'load all matching row in the final array
            Next t
        End If
    Next j
 Next i
 ReDim Preserve arrFin(1 To 5, 1 To k) 'keep only the values to be returned
 'drop the final array in the required range, at once
 sh.Range("R2").Resize(UBound(arrFin, 2), UBound(arrFin, 1)).Value = WorksheetFunction.Transpose(arrFin)
End Sub

【讨论】：

@MCTP17 ：很高兴我能帮上忙！与此同时，我评论了不够清晰的代码行。如果有不清楚的地方，请随时问...代码应该非常快，即使对于大范围也是如此...我们在这里的目的是教人们提问，仅列出一些，而不仅仅是提供要使用的代码。跨度>

【解决方案2】：

请将此视为硬编码解决方案，因为我没有 excel 并且我没有尝试该解决方案。在您的示例中，您只处理一个查找键值。您需要做的是创建另一个循环来考虑一系列查找键值。像这样的：

finalrow = Sheets("Sheet1").Range("A1000").End(xlUp).Row 
finalrowformultiple = Sheets("Sheet1").Range("H1000").End(xlUp).Row

For j = 3 To finalrowformultiple
    name = Cells(j ,8)
    For i = 3 To finalrow
            If Cells(i, 1) = name Then
            Range(Cells(i, 1), Cells(i, 5)).Copy
            Range("R100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
            End If
    Next i
Next j

此脚本将考虑 H 列中的每个查找值，而不是 P3 中的一个值。希望这会有所帮助。

【讨论】：