问如何按多列比较两个数组(逐行比较)

EN

Private Function CompareColumns(Table1 As Range, Table2 As Range, ColPairs() As Variant, Optional IsMatch As Variant = True, Optional NoMatch As Variant = False) As Variant
    Dim Table1Data As Variant
    Dim Table2Data As Variant
    Dim OutputData As Variant
    Dim rw1 As Long, rw2 As Long
    Dim Col As Long
    Dim FoundMatch As Boolean

    ' Move data to variant arrays
    Table1Data = Table1.Value2
    Table2Data = Table2.Value2

    ' Size return array
    ReDim OutputData(1 To UBound(Table1Data, 1), 1 To 1)

    ' Loop the arrays
    For rw2 = 1 To UBound(Table2Data, 1)
        OutputData(rw2, 1) = NoMatch ' initialise
        For rw1 = 1 To UBound(Table1Data, 1)
            FoundMatch = True
            For Col = LBound(ColPairs, 1) To UBound(ColPairs)
                If Table1Data(rw1, ColPairs(Col, 1)) <> Table2Data(rw2, ColPairs(Col, 2)) Then
                    FoundMatch = False ' column not a match, move to next row
                    Exit For
                End If
            Next
            If FoundMatch Then ' found a match
                OutputData(rw2, 1) = IsMatch
                Exit For ' exit Table2 loop when match found
            End If
        Next
    Next
    ' Return result to caller
    CompareColumns = OutputData
End Function

Sub Compare()
    Dim ws As Worksheet
    Dim Table1 As Range
    Dim Table2 As Range
    Dim Output As Range
    Dim OutputTable As Variant
    Dim ColPairs() As Variant

    Set ws = ActiveSheet ' update to suit your needs

    ' Set up ranges by any means you choose
    With ws
        Set Table1 = .Range(.Cells(2, 1), .Cells(.Rows.Count, 3).End(xlUp))
        Set Table2 = .Range(.Cells(2, 10), .Cells(.Rows.Count, 8).End(xlUp))
        Set Output = .Cells(2, 13).Resize(Table2.Rows.Count, 1)
    End With

    'Specify columns to compare
    ReDim ColPairs(1 To 3, 1 To 2)
    ColPairs(1, 1) = 1: ColPairs(1, 2) = 3
    ColPairs(2, 1) = 2: ColPairs(2, 2) = 2
    ColPairs(3, 1) = 3: ColPairs(3, 2) = 1

    ' Call Match function
    OutputTable = CompareColumns(Table1, Table2, ColPairs, "Yes", "No")

    ' Place Output on sheet
    Output = OutputTable
End Sub

Sub Compare()
    Dim firstColumn As String, lastColumn As String, resultsColumn As String, isFoundText As String, isNotFoundText As String, 
    Dim row As Integer, startChar As Integer, endChar As Integer, i As Integer
    Dim hasMatch As Boolean
    row = 2
    firstColumn = "H"
    lastColumn = "J"
    resultsColumn = "M"
    isFoundText = "YES"
    isNotFoundText = "NO"
    Do While Range("B" & row).Value <> ""
        startChar = Asc(firstColumn)
        endChar = Asc(lastColumn)
        hasMatch = False
        For i = startChar To endChar
            If Range(Chr(i) & row).Value = Range(Chr(i + 1) & row).Value Then
                hasMatch = True
            End If
            If Range(Chr(startChar) & row).Value = Range(Chr(i + 1) & row).Value Then
                hasMatch = True
            End If
        Next i
        If (hasMatch) Then
            Range(resultsColumn & row).Value = isFoundText
        Else
            Range(resultsColumn & row).Value = isNotFoundText
        End If
        row = row + 1
    Loop
End Sub

Dim lri as long, lrj as long, i as long, j as long
lri = cells(rows.count,"H").end(xlup).row
lrj = range(columns("B"),columns("D")).Find("*", , , , xlByRows, xlPrevious).Row
For i = 2 to lri
    For j = 2 to lrj
        If Cells(j,"B").Value = cells(i,"J").Value AND Cells(j,"C").Value = Cells(i,"I").Value AND Cells(j,"D").Value = Cells(i,"H").Value Then
        Cells(i,"M").Value = "Yes" 'don't need variables for these anymore
        'may want to put an exit to j loop if True
    Else 
        Cells(i,"M").Value = "No"
    End If
    row = row + 1
Loop