Question

我发布了一个关于找到多列标准匹配的问题。提供的答案很有效。但我尝试将其作为我的项目的通用解决方案，就使用了多少列标准而言。

以下是我引用的问题： Question＆amp; Answer I used

到目前为止，我已经设法提出了这个问题：

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])

基本上我想要的是它验证第一个值=它的相应查询列等等（即args（0）should = colmns（0）value，args（1）should = colmns （1）价值）

到目前为止，我可以使用上面的示例找到匹配项，但我不知道如何检查所有值是否同时匹配。此外，我无法找到任何本地函数来比较MSDN网站上的数组。这是一个导航IMO的尴尬网站。

不要让我的代表欺骗你。我是VBA的新手，并且是第一个承认我的新生，我很难转换的人。我个人并不认为MSDN文档与其他语言一样有用。因此，如果您可以共享您使用的任何资源，我将不胜感激。

为了简化我想要的结果：

获取包含客户列表的表1：

         A                B               C           D
  -----------------------------------------------------------
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，但每个客户端都由不同的参数查询：

          J            K         L                M
  -----------------------------------------------------------
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中选择相应的列。所以回到表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实际应用的实例。我试图使两个参数动态灵活。我生活在命名范围之外，但它并不是特定于那个

Answer 1

试试这个。请注意，没有错误检查 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

Answer 2

我找到了一个适合我和我的需求的解决方案;我和查尔斯的回答一起玩，根据他的反馈无法弄清楚结构。虽然，我确实从他的反馈中学到了一些信息并应用了它。希望这可以帮助其他人，因为它是丑陋或粗糙的。我想我自己试图想象循环中循环内的循环太难了。所以我决定采用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

所以基本上我做了动态INDEX/MATCH验证并相应地处理它。我现在可以用{1}参数/列调用=MULTIMATCHEXISTS来定义：

=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美分来提出其他的话

Answer 3

好的，这是一个更符合你想要的版本：它相当于你的任意标准和列的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

VBA UDF使用动态数组查找多列标准匹配

3 个答案: