Question

我以前一直走这条路。当我使用单个条件时，匹配功能有效，但不能在两个条件下正确使用它。

我当前的过程在NR_Qualtrics页面上查找，以在CaseID和Email上找到匹配项。因为根据我得到的每个文档，这些列的列可能会不同，所以我有一个过程可以识别行并返回CaseID和Email所在的范围。

我在此功能中要做的下一步是遍历NonResidential工作表中的每一行，以查找CaseID和Email的匹配项。我需要该函数返回在其上找到匹配项的行，并在O列中报告该行。目前，我仍然在尝试查找匹配的列。调试时，我不断收到错误2015和错误2029。我确定手动查看时匹配项存在。我不确定我的程序做错了什么。你能帮忙吗？

Sub NonResFindMultipleProviders()
    'This function finds any duplicate Case IDs for NR providers where they had surveys
    'This function needs to run before NonRes_ChkSurveyRcd
    'If there are duplicates, it will indicate that in the Notes Column (N)
    'If a duplicate exists, then it must match on Email and CaseID and show the value of Yes-NR_Qualtrics Row XX/No in Survey Recieved (Column O)
    Application.ScreenUpdating = False

    Dim r, lastRow, rowMatch As Long
    Dim colCaseID, colEmail, colResponseID As Long
    Dim rngCaseID, rngEmail, rngResponseID As Range
    Dim valEmail, valCaseID As String
    Dim result As Variant
    Dim shtNR As Worksheet
    Dim shtQNR As Worksheet

    Sheets("NonResidential").Select
    lastRow = getLastRow

    Range("A2").Select

    Set shtNR = ThisWorkbook.Sheets("NonResidential")
    Set shtQNR = ThisWorkbook.Sheets("NR_Qualtrics")

    colCaseID = FindColHeaderWText("NR_Qualtrics", "ExternalDataReference")
    Set rngCaseID = Worksheets("NR_Qualtrics").Columns(colCaseID)
    colEmail = FindColHeaderWText("NR_Qualtrics", "EmailAddress")
    Set rngEmail = Worksheets("NR_Qualtrics").Columns(colEmail)
    'colResponseID = FindColHeaderWText("NR_Qualtrics", "ResponseID")
    'Set rngResponseID = Worksheets("NR_Qualtrics").Columns(colResponseID)

    'The Notes field(column N) shows the duplicates.  Find matches on CaseID AND Email
    ''Not (IsError(Application.Match(Cells(r, 1).Value, rng, 0))) And
    For r = 2 To lastRow
        valCaseID = Cells(r, 1).Value   'Column A (1) has CaseIDs
        valEmail = Cells(r, 12).Value   'Column L (12) has emails

        result = shtNR.Evaluate("MATCH(" & valCaseID & "&" & valEmail & ",rngCaseID&rngEmail,0)")
        If (Not IsError(result)) Then    'Mark only if Notes - Column N (13) is marked with a duplicate - Need to put this in next.  RN, just evaluate everything
            Cells(r, 15).Value = "Yes"  'Column O (14) Survey Recieved marked with Yes
        End If
    Next r

    'Cleanup - Remove the words duplicate
    'Columns("N:N").Select
    'Selection.Replace What:="Duplicate", Replacement:="", LookAt:=xlWhole, _
    '    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    '    ReplaceFormat:=False

    Application.ScreenUpdating = True

End Sub

Answer 1

这是一个基于3个条件进行匹配的示例。尝试将您的范围和条件放到其中：

Sub MatchMultipleCritera()

    ' Cells containing the values to match
    Dim criteria1 As Range, criteria2 As Range, criteria3 As Range
    Set criteria1 = Range("A1")
    Set criteria2 = Range("B1")
    Set criteria3 = Range("C1")


    ' Ranges containing the values to be checked against the match values above.
    Dim rng1 As Range, rng2 As Range, rng3 As Range
    Set rng1 = Range("Table1[Item]")
    Set rng2 = Range("Table1[Active]")
    Set rng3 = Range("Table1[Quanitity2]")

    MsgBox "Row " & Evaluate("=MATCH(1,(" & criteria1.Address & "=" & rng1.Address & ")*(" & criteria2.Address & "=" & rng2.Address & ")*(" & criteria3.Address & "=" & rng3.Address & "))")
End Sub

在此示例中：

单元格A1，B1和C1包含我匹配的值。
我正在查找名为“ Table1”的表（Excel.ListObject），该表具有列“ Item”，“ Active”和“ Quantity”。
rng1中criteria1中的值，检查rng2中criteria2中的值，等等。
结果是行号。

这是使用数组公式对this ExcelJet article进行的VBA修改。 Evaluate函数默认将公式作为数组公式求值

VBA-从多个条件查找行

1 个答案: