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

按行值和突出显示差异比较Excel工作簿中的图纸

1 个答案: