VBA 到 return 查找列表中的所有匹配项

Question

我正在尝试实现一个 VBA 方法来搜索名称列表和 return 从提供的列表中匹配的所有实例。我需要 returned 的数据在 A2:E11 中。这可能要大得多，我包含的示例数据比我实际尝试使用它的数据简单得多。我要查找的值在 H3:H6 范围内。如果要查找更多查找值，这也可能更大。我试图获得的输出在 J3:N6 中。目前我使用的是 VBA 脚本，一次只能处理一个查找值。如果我只有一个查找值，该方法效果很好。我想知道我必须对下面的脚本进行哪些更改才能使其适用于我正在尝试做的事情。同样，我正在尝试 return 查找列表的所有匹配项并将该数据复制到 "output" 范围。我是 VBA 的新手，但我相信这是可能的。过去，由于类似的问题，我使用索引匹配数组 return 第 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

Answer 1

请将此视为硬编码解决方案，因为我没有 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 中的一个值。希望这有帮助。

Answer 2

请测试下一个代码：

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

VBA 到 return 查找列表中的所有匹配项

VBA to return all matches from a lookup list

lookup

excel

vba

match