如何按多列比较两个数组（行与行）

Question

我在一个电子表格中有两个表格。两者都有相同的列 - 名称、城市、省。我的目标是比较两者，如果连续三个值中的三个匹配，则拉“是”，如果不是，则拉“否”。我将行与这两个表中的行（不是随机单元格）进行比较。

我还没有找到合适的公式，所以可能需要编写代码。

我找到了一个很好的代码，但它只适用于查看一个数组中的相同值。我希望它可以适应我的问题。或者也许我需要另一个。

Sub Compare()
    Dim row As Integer
    row = 2
    Dim firstColumn As String
    firstColumn = "H"
    Dim lastColumn As String
    lastColumn = "J"
    Dim resultsColumn As String
    resultsColumn = "M"
    Dim isFoundText As String
    isFoundText = "YES"
    Dim isNotFoundText As String
    isNotFoundText = "NO"

    Do While Range("B" & row).Value <> ""

        Dim startChar As Integer
        startChar = Asc(firstColumn)
        Dim endChar As Integer
        endChar = Asc(lastColumn)
        Dim i As Integer
        Dim hasMatch As Boolean
        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

Answer 1

对于这种类型的任务，最好将数据移动到 Variant Arrays 并在它们上循环（快得多）。此外，模式匹配可以从数据中推广出去，从而实现更可重用的解决方案和关注点分离

比较函数

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

Answer 2

添加一些缩进以便我们阅读：

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

这会将每个单元格中的值与其各自的部分（B 到 J、C 到 I、D 到 H）进行比较。