比较数据

Question

例如，我有两个Excel工作表，内容相似，但顺序不同，请参阅以下内容。

sheet1
   colA | colB | colC | colD | colE | colF 
r1  1   |  11  |  111 |   a  |  aa  | aaa
r2  2   |  22  |  222 |   b  |  bb  | bbb 
r3  3   |  33  |  333 |   c  |  cc  | ccc 
r4  4   |  44  |  444 |   d  |  dd  | ddd 
r5  5   |  55  |  555 |   e  |  ee  | eee 
r6  6   |  66  |  666 |   f  |  ff  | fff 

sheet2
   colA | colB | colC | colD | colE | colF | colG
r1  1   |  11  |  111 |   a  |  aa  | aaa  | aaaa
r2  3   |  33  |  333 |   c  |  cc  | ccc  | cccc
r3  6   |  66  |  666 |   f  |  ff  | fff  | ffff
r4  2   |  22  |  222 |   b  |  BB  | BBB  | bbbb
r5  4   |  44  |  444 |   d  |  dd  | ddd  | dddd
r6  5   |  55  |  555 |   e  |  ee  | eee  | eeee

对于这两张表，colA就像数据库中表的主键一样，它们是唯一的，我想比较两行具有相同colA数据的行，但是不在sheet1中的colG不会被考虑，我想要什么要做的是在sheet2中添加一个新列，如下所示：

   colA | colB | colC | colD | colE | colF | colG | colH
r1  1   |  11  |  111 |   a  |  aa  | aaa  | aaaa | True
r3  3   |  33  |  333 |   c  |  cc  | ccc  | cccc | True
r6  6   |  66  |  666 |   f  |  ff  | fff  | ffff | True
r2  2   |  22  |  222 |   b  |  BB  | BBB  | bbbb | False
r4  4   |  44  |  444 |   d  |  dd  | ddd  | dddd | True
r5  5   |  55  |  555 |   e  |  ee  | eee  | eeee | True

我可以使用公式或宏做什么？非常感谢您阅读我的问题。

Answer 1

只需遍历并在输出中添加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

Answer 2

比较数据

仔细调整常量（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

比较2个不同的Excel工作表中的数据以找出差异

2 个答案:

比较数据