模糊Vlookup显示所有匹配的结果在一个单一的行
我知道，vlookup只返回一个结果，但我正在寻找一种方法来search2列，并返回匹配此查询的所有结果：
SUBSTITUTE("*"&C2&"*"," ","*") 这样它也会返回类似的匹配。 我能够返回第一个匹配（通过一个vlookup），但我需要返回所有匹配，并在一行中显示它们。
如果它会创build一个数组，我可以显示数组中第一个元素的行中的第一个匹配，显示与第二个元素的第二个匹配…等等。
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
谢谢！
尝试这个。 您可以使用它作为数组公式select合理数量的单元格以显示结果，或者将其用于代码中，并以您喜欢的任何方式转储到工作表中。
它接受一个string来search（它分割和testing单个string中的每个单词），然后是一个string，范围或数组的参数数组来search。它返回一个匹配数组，以便您可以使用它作为数组公式或与任何其他数组一起使用。
用法示例：
-
=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")带string的示例 -
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 'eg 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
使用脚本字典和一些数组/范围操作。 我testing了大约30,000行，比我眨眼的速度快了大约10000次。
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
基本上我把你的search参数（ C2 ）分成一个数组。 然后我迭代这些列中的每个单元格，从C2分割数组的每个元素进行testing。 如果C2中的任何单词都没有find，那么我将其忽略为部分匹配，而只是寻找匹配的两个单词，没有特定的顺序。
如果两个单词匹配，则将该值添加到字典对象。
然后你可以通过引用dictionary.Items来返回一个数组来访问所有匹配的值。