Как сравнить два массива по нескольким столбцам (строка за строкой)

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