比较数据

仔细调整常量（Const）部分中的值以满足您的需要。

Sub CompareData()

    Const cSrc As Variant = "Sheet1"    ' Source Worksheet Name/Index
    Const cSrcChecks As String = "B:F"  ' Source Check Columns Address
    Const cSrcCrit As Variant = "A"     ' Source Criteria Column Letter/Number
    Const cSrcFR As Long = 1            ' Source First Row Number
    Const cTgt As Variant = "Sheet2"    ' Target Worksheet Name/Index
    Const cTgtChecks As String = "B:F"  ' Target Check Columns Address
    Const cTgtCrit As Variant = "A"     ' Target Criteria Column Letter/Number
    Const cRes As Variant = "H"         ' Result Column Letter/Number
    Const cTgtFR As Long = 1            ' Target First Row Number
    Const cYes As Variant = "True"      ' Yes String
    Const cNo As Variant = "False"      ' No String
    Const cNot As Variant = "Not Found" ' Not Found String
    Const cEmpty As Variant = "Empty"   ' Empty String

    Dim vntSrcC As Variant  ' Source Criteria Array
    Dim vntTgtC As Variant  ' Target Criteria Array
    Dim vntS As Variant     ' Source Array
    Dim vntT As Variant     ' Target Array
    Dim vntR As Variant     ' Result Array
    Dim varTgt As Variant   ' Current Value (in Target Criteria Array)
    Dim NorSrc As Long      ' Source Number of Rows
    Dim NorTgt As Long      ' Target Number of Rows
    Dim Noc As Long         ' Source/Target Number of Columns
    Dim Lur As Long         ' Source/Target Last Row Number
    Dim i As Long           ' Target/Criteria/Result Array Row Counter
    Dim j As Long           ' Source/Target Array Columns Counter
    Dim k As Long           ' Source/Criteria Array Row Counter

    ' In Source Worksheet (Check Columns)
    With ThisWorkbook.Worksheets(cSrc).Columns(cSrcChecks)
        ' Calculate (count) Source/Target Number of Columns.
        Noc = .Columns.Count
        ' Calculate Source Last Used Row Number.
        Lur = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Row
        ' Calculate Source Number of Rows.
        NorSrc = Lur - cSrcFR + 1
        ' Calculate Source Criteria Range.
        ' Copy Source Criteria Range to Source Criteria Array.
        vntSrcC = .Worksheet.Columns(cSrcCrit) _
                .Resize(NorSrc).Offset(cSrcFR - 1)
        ' Calculate Source Range.
        ' Copy Source Range to Source Array.
        vntS = .Resize(NorSrc, Noc).Offset(cSrcFR - 1)
    End With

    ' In Target Worksheet (Check Columns)
    With ThisWorkbook.Worksheets(cTgt).Columns(cTgtChecks)
        ' Check if Target Number of Columns is euqal to Source Number of
        ' Columns.
        If .Columns.Count <> Noc Then
            MsgBox "The number of Check Columns NOT equal. Adjust Source " _
                    & "Check Columns (cSrcChecks) and Target Check Columns " _
                    & "(cTgtChecks) to have an equal number of columns.", _
                    vbCritical, "Check Columns Error"
            Exit Sub
        End If
        ' Calculate Target Last Used Row Number.
        Lur = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Row
        ' Calculate Target Number of Rows.
        NorTgt = Lur - cTgtFR + 1
        ' Calculate Target Criteria Range.
        ' Copy Target Criteria Range to Target Criteria Array.
        vntTgtC = .Worksheet.Columns(cTgtCrit) _
                .Resize(NorTgt).Offset(cTgtFR - 1)
        ' Calculate Target Range.
        ' Copy Target Range to Target Array.
        vntT = .Resize(NorTgt, Noc).Offset(cTgtFR - 1)
    End With

    ' Resize Result Array to rows of Target Array and one column.
    ReDim vntR(1 To NorTgt, 1 To 1)

    ' Loop through rows of Target Criteria Array.
    For i = 1 To NorTgt
        ' Write current value in Target Criteria Array to Current Value.
        varTgt = vntTgtC(i, 1)
        ' Check if Current Value is not empty.
        If varTgt <> "" Then  ' NOT empty (<>"").
            ' Check if Match function produces an error.
            If Not IsError(Application.Match(varTgt, vntSrcC, 0)) Then ' FOUND.
                ' Write position of found match to Source/Criteria Array
                ' Row Counter.
                k = Application.Match(varTgt, vntSrcC, 0)
                ' Loop through columns of Source/Target Array.
                For j = 1 To Noc
                    ' Check if values in Source and Target Array are NOT equal.
                    If vntS(k, j) <> vntT(i, j) Then Exit For
                Next
                ' VBA Help: ...For counter = start To end...
                ' Use the 'For Next Trick' to determine if all values were
                ' equal i.e. if counter is by one greater than end, the loop
                ' was NOT interrupted i.e. no value is NOT equal, i.e. all
                ' values are equal.
                If j = Noc + 1 Then   ' EQUAL.
                    vntR(i, 1) = cYes
                  Else                ' NOT equal.
                    vntR(i, 1) = cNo
                End If
              Else                    ' NOT found.
                vntR(i, 1) = cNot
            End If
          Else                        ' EMPTY (="").
            vntR(i, 1) = cEmpty
        End If
    Next

    ' In Target Worksheet
    With ThisWorkbook.Worksheets(cTgt).Columns(cRes)
        ' Calculate Result Range.
        ' Copy Result Array to Result Range.
        .Resize(NorTgt).Offset(cTgtFR - 1) = vntR
    End With

End Sub

只需迭代并添加true/false作为输出（假设数据位于不同工作表的相同位置：

Sub ConditionCheck()

    Dim i As Long, j As Long
    Dim numberCols as long
    Dim myFlag as Boolean
    Dim lRow as Long
    Dim wsSheet1 as Worksheet, wsSheet2 as Worksheet
   'edit the sheets as per the name of yours
    Set wsSheet1 = Sheets("Sheet1")
    Set wsSheet2 = Sheets("Sheet2")

   'assuming table you want output on is on sheet 2
   lRow = wsSheet2.Range("A" & wsSheet2.Rows.Count).End(xlUp).Row
   'number of columns in your table (6 in example above)
   numberCols = 6
   'iterate vertically through table
   For i = 1 to lRow
       'iterate horizontally through table to compare values
       For j = 1 to numberCols
           'compare values to check for differences
           'if dont match then set flag to false
           If wsSheet1.Cells(i,j).Value <> wsSheet2.Cells(i,j).Value Then
               myFlag = False
               Exit For
           Else
               myFlag = True
           End If
       Next j

       'once the full condition has been checked we insert result
       If myFlag = True Then
           wsSheet2.Cells(i,(numberCols+1)).Value = "True"
       Else
           wsSheet2.Cells(i,(numberCols+1)).Value = "False"
       End If
       'reset flag
       myFlag = False
   Next i

End Sub