VBA UDF使用dynamic数组来find多列标准匹配

我发布了一个关于find多列标准匹配的问题。 提供的答案很好。 但是,我试图使它成为我的项目的通用解决scheme,就使用了多less列标准而言。

这是我所引用的问题 : 我使用的 问题和答案

这是我迄今设法提出的:

Public Function CRITERIA(ParamArray values() As Variant) As Variant .... CRITERIA = values End Function 

在单元格中引用的实际UDF将是:

 Public Function MULTIMATCHEXISTS(args As Variant, ParamArray colmns() As Variant) As Boolean Dim argsCount As Long, colmnsCount As Long, cl As Long, a As Long argsCount = UBound(args) - LBound(args) + 1 colmnsCount = UBound(colmns) - LBound(colmns) + 1 Dim tbl As ListObject Dim ws As Worksheet Dim lr As ListRow Dim match_candidate As Variant, arg As Variant If argsCount <> colmnsCount Then .... Exit Function Else 'Get the name of the table from any column provided (this of courses assumes a 1:1 table search) Set tbl = colmns(0).ListObject 'Get tables worksheet from the table object Set ws = ThisWorkbook.Sheets(tbl.Parent.Name) 'Iterate through columns? For cl = LBound(colmns) To UBound(colmns) 'Get each value from column For each lr In tbl.ListRows match_candidate = Intersect(lr.Range, colmns(cl)).value 'Iterate through arguments? For a = LBound(args) To UBound(args) If match_candidate = args(a) Then Debug.Print "its a match for " & args(a) & " in column " & colmns(cl) MULTIMATCHEXISTS = True Else MULTIMATCHEXISTS = False End If Next a Next lr Next cl End If End Function 

有人会使用UDF如下:

  =MULTIMATCHEXISTS(CRITERIA(A2,A3,A4), Table2[Column1], Table2[Column8], Table2[Column5]) 

基本上我想是为了validation,如果第一个值=它是相应的查询列等等(Ie args(0)应= colmns(0)值,args(1)应= colmns(1)值)

到目前为止,我可以使用上面的例子find匹配,但是我不知道如何检查ALL值是否同时匹配。 此外,我找不到任何本机函数来比较MSDN网站上的数组。 导航IMO是一个尴尬的网站。

不要让我的代表欺骗你。 我是新来的VBA,并且是第一个承认我的新手,我很难转换。 我个人认为MSDN文档不像其他语言那样有帮助。 所以,如果你可以分享你使用的任何资源,我将不胜感激。


在这里输入图像说明


为了简化我期望的结果:

拿到表1中有一个客户名单:

  ABCD ----------------------------------------------------------- 1 | Name | Email | Phone | ISMATCH? | ----------------------------------------------------------- 2 | Steve Jobs | stevejobs@gmail.com | 123456 | True | ----------------------------------------------------------- 3 | Bill Gates | billgates@apple.com | 123456 | True | ----------------------------------------------------------- 4 | Steve Woz | stevewoz@outlook.com| 123456 | False | ----------------------------------------------------------- 

拿到表2中有这些客户端的详细描述,但每个客户端被不同的参数查询:

  JKLM ----------------------------------------------------------- 1 | Name | Company | Phone | Email | ----------------------------------------------------------- 2 | Steve Jobs | Apple | 123456 | stevejobs@gmail.com | ----------------------------------------------------------- 3 | Bill Gates | Apple | 123456 | billgates@apple.com | ----------------------------------------------------------- 4 |Stevie Wonder | Apple | 123456 | steviewon@outlook.com | ----------------------------------------------------------- 

我想要的是能够挑选哪些标准来评估,然后在表2中select相应的列。所以回到表1中,D2就是这样的:

  =MULTIMATCHEXISTS(CRITERIA([@NAME], [@EMAIL]), Table2[Name], Table2[Email]) 

但是让我们来说比尔盖茨,我想检查超过这两个标准,所以表1 D3将是:

  =MULTIMATCHEXISTS(CRITERIA([@NAME], [@PHONE], [@EMAIL]), Table2[Name], Table2[Phone], Table2[Email]) 

对于Steve Woz表1 D4:

  =MULTIMATCHEXISTS([@Name], Table2[Name]) 

这些都是我UDF在行动中的实际例子。 我试图使两个参数dynamic灵活。 我活在有名的范围之外,但不一定是特定的

尝试这个。 请注意,没有错误检查。
Filter_Data数组是基于1的,但是ParamArray是从零开始的!

 OPTION COMPARE TEXT Function MULTIMATCHEXISTS(Filter_Data As Variant, ParamArray Values() As Variant) As Variant Dim j As Long Dim k As Long MULTIMATCHEXISTS = False If TypeOf Filter_Data Is Range Then Filter_Data = Filter_Data.Value2 For j = LBound(Filter_Data) To UBound(Filter_Data) For k = LBound(Values) To UBound(Values) If Filter_Data(j, k + 1) = Values(k) Then ' ' true if all the columns match ' If k = UBound(Values) Then MULTIMATCHEXISTS = True Else Exit For ' do not check remaining columns End If Next k ' ' exit at first row match for all cols ' If MULTIMATCHEXISTS Then Exit For Next j End Function 

我find了适合我和我需求的解决scheme。 我和查尔斯的答案一起玩弄,根据他的反馈无法弄清楚结构。 虽然我从他的反馈中学到了一些我学到的知识并应用了它。 希望这可以帮助别人,就像丑陋或粗糙。 我想我自己试图想象循环内循环内的循环,这让我感到很难过。 所以我决定解决Index/Match方法。

而且更重要的是,我真的很想学习这门语言,所以如果你是一名职业球员,发现一些问题我应该关注,请让我知道。

 Public Function MULTIMATCHEXISTS(args As Variant, ParamArray colmns() As Variant) As Boolean Dim argsCount As Long, colmnsCount As Long Dim i As Long, lRow As Long Dim match_candidate As Variant Dim cell As Range On Error GoTo Handler argsCount = UBound(args) - LBound(args) + 1 colmnsCount = UBound(colmns) - LBound(colmns) + 1 check: MULTIMATCHEXISTS = False 'Check if array counts match before even commencing a query, if not throw #value error If argsCount = colmnsCount Then On Error GoTo DoesNotExist: 'Check if minimum requirements are met If argsCount = 1 Then 'If only 1 argument given find the first match lRow = Application.WorksheetFunction.match(args, colmns(0), 0) MULTIMATCHEXISTS = True Exit Function ElseIf argsCount > 1 Then 'Get all values from the first column provided in the colmns() array 'rest of the columns don't matter so we don't need to iterate through them because this is 1:1 Table search function For Each cell In colmns(0) If UCase(args(1)) = UCase(cell.value) Then 'Found a match 'Set the lRow to each cells row number 'I don't like getting the row number of a ListObject cell by substracting from HeaderRowRange, 'some people don't use table headers resulting in false returns lRow = cell.Row - cell.ListObject.ListRows(1).Range.Row + 1 For i = 0 To UBound(args) 'Get all values in each column in colmns() within the same row match_candidate = Application.WorksheetFunction.index(colmns(i), lRow, 0) 'Check if all values match their respective arguments If args(i + 1) = match_candidate Then If i + 1 = argsCount Then 'All values match args; exit function MULTIMATCHEXISTS = True Exit Function End If Else 'Not all values match, go to next cell iteration to check for more cells that match args(1) GoTo NextCell End If Next i End If NextCell: Next cell End If Else GoTo Handler End If Handler: ''Handle Err If Err.Number = 13 Then Err.Clear If Not IsEmpty(args) And Not IsEmpty(colmns(0)) Then argsCount = 1 colmnsCount = 1 Resume check End If Else 'Dirty MsgBox 1/0 End If DoesNotExist: MULTIMATCHEXISTS = False Exit Function End Function 

所以基本上我做了一个dynamic的INDEX/MATCHvalidation并相应地进行处理。 我现在可以调用=MULTIMATCHEXISTS只有1个参数/列未定义:

 =MULTIMATCHEXISTS(CRITERIA(A2,A3,A4,A5,A6,A7), Table2[Column2], Table2[Column3], Table2[Column4], Table2[Column5], Table2[Column6], Table2[Column7]) 

其中1个参数是:

 =MULTIMATCHEXISTS(A2, Table2[Column5]) 

虽然“multimatch”这个名字不适合这种情况

如果你想用你的2美分来报价,我仍然有兴趣看看其他人想出了什么

好的,这是一个更接近你想要的版本:它是你的任意标准和列的MATCH的等价物。
调用示例:= multimatch2(条件(C2,B2,A2),C4:C70,B4:B70,A4:A70)

  Option Compare Text Function MULTIMATCH2(Criterias As Variant, ParamArray Cols() As Variant) As Variant ' ' return row index for multi-column match ' Dim j As Long Dim k As Long Dim vColArr() As Variant ' MULTIMATCH2 = 0 ' ReDim vColArr(LBound(Cols) To UBound(Cols)) ' For k = LBound(Cols) To UBound(Cols) If TypeOf Cols(k) Is Range Then ' ' convert column ranges to array of 2-d array values ' vColArr(k) = Cols(k).Value2 End If ' ' convert criteria to values ' If TypeOf Criterias(k + 1) Is Range Then Criterias(k + 1) = Criterias(k + 1).Value2 Next k ' For j = LBound(vColArr(0)) To UBound(vColArr(0)) For k = LBound(Cols) To UBound(Cols) ' ' each element of vColarr contains a 2d array of values ' If vColArr(k)(j, 1) = Criterias(k + 1) Then ' ' set Row Index if all the columns match ' If k = UBound(Cols) Then MULTIMATCH2 = j Else Exit For ' do not check remaining columns End If Next k ' ' exit at first row match for all cols ' If MULTIMATCH2 > 0 Then Exit For Next j ' End Function Public Function CRITERIA(ParamArray values() As Variant) As Variant '.... CRITERIA = values End Function