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

我想比较工作簿中的三个工作表（应该是相同的），并突出显示任何不匹配的单元格。 我已经基于下面的代码使用VBA来比较两个Excel工作簿 ：

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

我从一读中理解的是，你有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")更改为单词或者只需在一个工作簿中select范围。

Answer 2

我扩展了@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