我知道 vlookup 只返回一个结果，但我正在寻找一种跨 2 列搜索并返回与此查询匹配的所有结果的方法：
SUBSTITUTE("*"&C2&"*"," ","*")
这样，它也返回类似的匹配项。我可以返回第一个匹配项（通过 vlookup），但我需要返回所有匹配项并将它们显示在一行中。
如果它将创建一个数组，我可以显示行中的第一个匹配项与数组中的第一个元素，显示第二个匹配项与第二个元素...等等。
到目前为止，VBA：
Function Occur(text, occurence, column_to_check)
newarray = Split(text, " ")
Dim temp As New Collection
Dim intX As Integer
For i = 1 To 90000
intX = 1
For j = 0 To Len(newarray)
If Not InStr(Range(column_to_check + i).Value, newarray(j)) Then
intX = 0
End If
Next j
Exit For
If intX = 1 Then
temp.Add (Cells(i, column_to_check))
End If
Next i
End Function
谢谢！
使用脚本字典和一些数组/范围操作。我在大约 30，000 行上对此进行了测试，它返回的匹配项比我眨眼的速度快了大约 10，000 个匹配项。
Sub TestWithoutRE()
Dim dict As Object
Dim srchStrings() As String
Dim s As Variant
Dim colsToSearch As Range
Dim cl As Range
Dim allMatch As Boolean
Dim matchArray As Variant
'Define the strings you're looking for
srchStrings = Split([C2], " ")
'Define the ranges to search:
Set colsToSearch = Range("F1:G33215")
'Build a dictionary of the column data
Set dict = CreateObject("Scripting.Dictionary")
For Each cl In colsToSearch.Cells
allMatch = True 'this will be set to false on the first non-matching value, no worries
'Make sure each word is in the cell's value:
For Each s In srchStrings
If InStr(1, LCase(cl), LCase(s)) = 0 Then
allMatch = allMatch + 1
Exit For 'exit this if ANY substring is not found
End If
Next
If allMatch Then
'## As long as all strings were found, add this item to the dictionary
dict.Add cl.Address, cl.Value
End If
Next
'## Here is your array of matching values:
matchArray = dict.Items
End Sub
基本上我把你的搜索参数（C2）分成一个数组。然后，我迭代这些列中的每个单元格，针对 C2 中拆分数组的每个元素进行测试。 如果找不到C2中的任何单词，那么我将其作为部分匹配忽略，您只是在寻找两个单词匹配，没有特定的顺序。
如果两个单词匹配，则将值添加到字典对象。
然后，您可以通过引用返回数组的dictionary.Items来访问所有匹配的值。
试试这个。您可以将其用作数组公式，选择合理数量的单元格来显示结果，也可以在代码中使用它并以您喜欢的任何方式转储到工作表。
它接受要搜索的单个字符串（它拆分并测试单个字符串中的每个单词），然后接受要搜索的字符串、范围或数组的参数数组。它返回一个匹配项数组，因此您可以将其用作数组公式，也可以在代码中将其用作任何其他数组。
使用示例：
- 具有单个连续范围的
=GetAllMatches("two three",A1:A5)示例 -
=GetAllMatches("two three",A1,A3:A20,B5:B8,D1)'具有非连续单元格的示例 - 数组
=GetAllMatches("two three",{"one two","three two","one two three"})示例 -
=GetAllMatches("two three","one two","one","three two","one two three")字符串示例 -
For each match in GetAllMatches(blah,blahblah):Debug.Print match:Next match在代码而不是公式中使用的示例
您可能需要调整才能品尝，但我已经在代码中评论了它的作用。
代码示例：
Public Function GetAllMatches(searchFor As String, ParamArray searchWithin()) As Variant
'I use a ParamArray to handle the case of wanting to pass in non-contiguous ranges to search other
'e.g. Blah(A1,A2,A3,C4:C10,E5)
'nice little feature of Excel formulae :)
Dim searchRange, arr, ele, searchComponents
Dim i As Long
Dim results As Collection
Dim area As Range
Set results = New Collection
'generate words to test
searchComponents = Split(searchFor, " ")
For Each searchRange In searchWithin
If TypeOf searchRange Is Range Then 'range (we test to handle user passing in arrays)
For Each area In searchRange.Areas 'we enumerate to handle multi-area ranges
arr = area.Value
If VarType(arr) < vbArray Then 'we test to handle single cell areas
If isMatch(arr, searchComponents) Then results.Add arr 'is a match so add to results
Else 'is an array, so enumerate
For Each ele In arr
If isMatch(ele, searchComponents) Then results.Add ele 'is a match so add to results
Next ele
End If
Next area
Else
Select Case VarType(searchRange)
Case Is > vbArray 'user passed in an array not a range
For Each ele In searchRange 'enumerate, not iterate, to handle multiple dimensions etc
If isMatch(ele, searchComponents) Then results.Add ele 'is a match so add to results
Next ele
Case vbString
If isMatch(searchRange, searchComponents) Then results.Add searchRange 'is a match so add to results
Case Else 'no idea - return an error then fail fast (suppressed if called by an excel formula so ok)
GetAllMatches = CVErr(XlCVError.xlErrRef)
Err.Raise 1, "GetAllMatches", "Invalid Argument"
End Select
End If
Next searchRange
'Process Results
If results.Count = 0 Then 'no matches
GetAllMatches = CVErr(XlCVError.xlErrNA) 'return #N/A
Else
'process results into an array
ReDim arr(0 To results.Count - 1)
For i = 0 To UBound(arr)
arr(i) = results(i + 1)
Next i
GetAllMatches = arr 'Return the array of matches
End If
End Function
Private Function isMatch(ByRef searchIn, ByRef searchComponents) As Boolean
Dim ele
For Each ele In searchComponents
If Not (InStr(1, searchIn, ele, vbTextCompare) > 0) Then
Exit Function
End If
Next ele
isMatch = True
End Function
电子表格示例：
one
one two
one two three
one three two
four three one two
结果： one two three one three two four three one two