按行值比较 Excel 工作簿中的工作表并突出显示差异

Question

我在 Excel 工作簿中有两张工作表，Sheet1 和 Sheet2。我想将这些工作表与突出显示的工作表之间的任何差异进行比较。

我最初尝试使用条件格式将工作表 1 中的单元格与工作表 2 中的单元格进行比较。但是，这不起作用，因为新行被添加到第二个工作表中，因此单元格不再直接对应于第一个工作表。

我试图弄清楚如何比较，例如，表 1 中名称为“tony”的行与表 2 中名称相同的行，即使条目位于不同的行/不同的单元格中在工作表 2 中。然后我希望突出显示工作表之间的任何差异。

Answer 1

这是一个很长的解决方案。它识别 sheet1 或 sheet2 中的额外行，并突出显示具有不同内容的任何单元格。 Is 假定 ResID 位于 C 列中，并且它是每一行的唯一标识符。它按 ResID 对两张表进行排序，以便于比较。

Option Explicit

Sub do_Compare()
    ' lets assume that the columns have the same names and are in the same sequence.
    ' if not, rearrange them to make them so.

    ' some vars
    Dim f1Sheet As String, f1maxRows As Long, f1nRow As Long, f1Key As Long
    Dim f2Sheet As String, f2maxRows As Long, f2nRow As Long, f2Key As Long
    f1Sheet = "Sheet1"
    f2Sheet = "Sheet2"
    f1nRow = 2
    f2nRow = 2
    f1maxRows = Sheets(f1Sheet).Cells(Rows.Count, "A").End(xlUp).Row
    f2maxRows = Sheets(f2Sheet).Cells(Rows.Count, "A").End(xlUp).Row
    '''Cells(Rows.Count, 1).End(xlUp).Row

    ' SORT each sheet
    do_SortTheSheet f1Sheet, f1maxRows
    do_SortTheSheet f2Sheet, f2maxRows

    ' match/merge compare the keys
    Dim lowKey As Long, maxCol As Long, nCol As Long
    Sheets(f1Sheet).Select
    maxCol = Range("A1").End(xlToRight).Column
    Do While f1nRow <= f1maxRows And f2nRow <= f2maxRows
        ' get new keys
        If f1nRow <= f1maxRows Then
            f1Key = Sheets(f1Sheet).Cells(f1nRow, "C")
        Else
            f1Key = 999999999#
        End If
        If f2nRow <= f2maxRows Then
            f2Key = Sheets(f2Sheet).Cells(f2nRow, "C")
        Else
            f2Key = 999999999#
        End If

        ' find low key
        If f1Key = f2Key Then
            ' compare columns
            For nCol = 1 To maxCol
                If Sheets(f1Sheet).Cells(f1nRow, nCol) <> Sheets(f2Sheet).Cells(f2nRow, nCol) Then
                    Sheets(f1Sheet).Cells(f1nRow, nCol).Interior.ColorIndex = 22
                    Sheets(f2Sheet).Cells(f2nRow, nCol).Interior.ColorIndex = 22
                Else  ' remove any prior color
                    Sheets(f1Sheet).Cells(f1nRow, nCol).Interior.ColorIndex = 0
                    Sheets(f2Sheet).Cells(f2nRow, nCol).Interior.ColorIndex = 0
                End If
            Next nCol
            ' bump to next row
            f1nRow = f1nRow + 1
            f2nRow = f2nRow + 1
        ElseIf f1Key < f2Key Then
            ' f1 has extra row -- highlight entire row
            For nCol = 1 To maxCol
                Sheets(f1Sheet).Cells(f1nRow, nCol).Interior.ColorIndex = 22
            Next nCol
            f1nRow = f1nRow + 1
        Else ''If f1Key > f2Key Then
            ' f2 has extra row -- highlight entire row
            For nCol = 1 To maxCol
                Sheets(f2Sheet).Cells(f2nRow, nCol).Interior.ColorIndex = 22
            Next nCol
            f2nRow = f2nRow + 1
        End If

    Loop ' on the do While


End Sub

Sub do_SortTheSheet(SheetName As String, maxRows As Long)
    ' some vars and initialization
    Dim key1 As String, key2 As String, rangeAll As String, maxCol As String
    Sheets(SheetName).Select
    Cells.Select
    maxCol = Split(Columns(Range("A1").End(xlToRight).Column).Address(, False), ":")(1)

    ' (Range needs to be adjusted to fit the data) <<<<<<<<<<<<<<<
    key1 = "C2:C" & maxRows
    key2 = "B2:B" & maxRows
    rangeAll = "A1:" & maxCol & maxRows

    ' setup and do the sort
    ActiveWorkbook.Worksheets(SheetName).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(SheetName).Sort.SortFields.Add Key:=Range(key1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(SheetName).Sort.SortFields.Add Key:=Range(key2) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(SheetName).Sort
        .SetRange Range(rangeAll)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub