Excelでワークシートを比較しています - 範囲が配列と一致しません

Question

ブック内の3つのワークシート（同一である必要があります）を比較し、不一致のセルを強調表示します。私は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

私が最初の読書から理解したことは、あなたが比較したい3つのワークシートがあることです。このコードは、ワークブックの最初の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 

をあなたは、3つのワークシートに範囲A1:Z10を比較Worksheets(1).Range("A1:Z10")との言葉Selectionを変更するか、または単に1つのワークブックの範囲を選択します。

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