比较 Excel 中的工作表 - 我的范围与我的数组不匹配

Question

我想比较工作簿中的三个工作表（应该相同）并突出显示所有不匹配的单元格。我将以下代码基于Using VBA to compare two Excel workbooks:

Sub CompareWorksheets()

Dim varSheetA As Worksheet
Dim varSheetB As Worksheet
Dim varSheetC As Worksheet
Dim varSheetAr As Variant
Dim varSheetBr As Variant
Dim varSheetCr As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long

Set varSheetA = Worksheets("DS") 
Set varSheetB = Worksheets("HT") 
Set varSheetC = Worksheets("NM") 

strRangeToCheck = ("A1:L30")
' If you know the data will only be in a smaller range, reduce the size of the ranges above.

varSheetAr = varSheetA.Range(strRangeToCheck).Value
varSheetBr = varSheetB.Range(strRangeToCheck).Value
varSheetCr = varSheetC.Range(strRangeToCheck).Value ' or whatever your other sheet is.


For iRow = LBound(varSheetAr, 1) To UBound(varSheetAr, 1)
    For iCol = LBound(varSheetAr, 2) To UBound(varSheetAr, 2)
        Debug.Print iRow, iCol
        If varSheetAr(iRow, iCol) = varSheetBr(iRow, iCol) And varSheetAr(iRow, iCol) = varSheetCr(iRow, iCol) Then
          varSheetA.Cells(iRow, iCol).Interior.ColorIndex = xlNone
          varSheetB.Cells(iRow, iCol).Interior.ColorIndex = xlNone
          varSheetC.Cells(iRow, iCol).Interior.ColorIndex = xlNone
        Else
          varSheetA.Cells(iRow, iCol).Interior.ColorIndex = 22
          varSheetB.Cells(iRow, iCol).Interior.ColorIndex = 22
          varSheetC.Cells(iRow, iCol).Interior.ColorIndex = 22

        End If
    Next
Next

End Sub

问题是，当“strRangeToCheck”从 A1 开始时，一切正常，但只要我将范围更改为 (“B4:C6”) 之类的东西，似乎仍在进行正确的比较，但是被突出显示的单元格总是被移回到单元格 A1 作为起点（而不是 B4，这是我想要的）。换句话说，突出显示的“模式”是正确的，但是向上移动了几个单元格。

Answer 1

我扩展了@Vityata 示例。

CompareWorksheets 最多可在 60 个工作表上比较相同范围，而CompareRanges 将比较相同大小和形状的范围。

Sub Test_Comparisons()
    CompareWorksheets "A1:L30", Worksheets("DS"), Worksheets("HT"), Worksheets("NM")
    CompareRanges Worksheets("DS").Range("A1:L30"), Worksheets("HT").Range("K11:V40"), Worksheets("NM").Range("A101:L130")
End Sub

Sub CompareWorksheets(CompareAddress As String, ParamArray arrWorkSheets() As Variant)
    Application.ScreenUpdating = False

    Dim cell As Range
    Dim x As Long
    Dim bFlag As Boolean

    'Reset all the colors
    For x = 0 To UBound(arrWorkSheets)
        arrWorkSheets(x).Range(CompareAddress).Interior.ColorIndex = xlNone
    Next

    For Each cell In arrWorkSheets(0).Range(CompareAddress)
        bFlag = False
        For x = 1 To UBound(arrWorkSheets)
            If arrWorkSheets(x).Range(cell.ADDRESS).Value <> cell.Value Then
                bFlag = True
                Exit For
            End If
        Next

        If bFlag Then
            For x = 0 To UBound(arrWorkSheets)
                arrWorkSheets(x).Range(cell.ADDRESS).Interior.ColorIndex = 22
            Next
        End If
    Next

    Application.ScreenUpdating = True
End Sub


Sub CompareRanges(ParamArray arrRanges() As Variant)
    Application.ScreenUpdating = False

    Dim cell As Range
    Dim x As Long, y As Long, z As Long
    Dim bFlag As Boolean

    'Reset all the colors
    For z = 0 To UBound(arrRanges)
        arrRanges(z).Interior.ColorIndex = xlNone
    Next

    For x = 1 To arrRanges(0).Rows.Count
        For y = 1 To arrRanges(0).Rows.Count
            For z = 1 To UBound(arrWorkSheets)
                If arrWorkSheets(1).Cells(x, y).Value <> arrWorkSheets(z).Cells(x, y).Value Then
                    bFlag = True
                    Exit For
                End If
            Next
            If bFlag Then
                For z = 0 To UBound(arrWorkSheets)
                    arrWorkSheets(z).Cells(x, y).Interior.ColorIndex = 22
                Next
            End If
        Next
    Next

    Application.ScreenUpdating = True
End Sub

Answer 2

我从第一次阅读中了解到，您有 3 个要比较的工作表。如果您想比较工作簿前三个工作表中的选定范围，则此代码有效。它将每个工作簿中的不同值涂成红色：

Option Explicit

Sub compareWorksheets()

    Dim rngCell As Range
    Dim counter As Long

    For Each rngCell In Selection

       If Worksheets(1).Range(rngCell.Address) <> Worksheets(2).Range(rngCell.Address) _
       Or Worksheets(1).Range(rngCell.Address) <> Worksheets(3).Range(rngCell.Address) Then
            For counter = 1 To 3
                Worksheets(counter).Range(rngCell.Address).Interior.Color = vbRed
            Next counter
       End If

    Next rngCell

End Sub

如果您想比较三个工作表中的A1:Z10 范围，请将单词Selection 更改为Worksheets(1).Range("A1:Z10") 或直接在一个工作簿中选择该范围。