(ネタ) VBA シート間の差分比較

VBA
ネタ VBA ファイル差分確認

やりたいこと

シート1とシート2の差分がある箇所のセル色を黄色にします。

シート1

シート2

コード

Sub シート間差分確認()
 
Dim Sheets_1 As Worksheet
Dim Sheets_2 As Worksheet
Dim myList_1 As Variant
Dim myList_2 As Variant
Dim i As Long
Dim j As Long
Dim retMsg As Integer
 
 Set Sheets_1 = Sheets("Sheet1")
 Set Sheets_2 = Sheets("Sheet2")
      
 '各シートのA~列のデータを配列に格納
 Sheets_1.Select
 myList_1 = Sheets_1.Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 100).Value
     
 Sheets_2.Select
 myList_2 = Sheets_2.Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 100).Value
     
 '「シート1」に色つける
 For i = 1 To UBound(myList_1)
    '列ループ
     For j = 1 To 100
        '2つのシートの値が異なる場合、セルに色をつける
         If myList_1(i, j) <> myList_2(i, j) Then
           'エラーが発生した場合は、異なる値なのでセルに色をつける
            On Error Resume Next
            Sheets_1.Cells(i, j).Interior.Color = 65535
            retMsg = 1
         End If
     Next j
 Next i
     
 '「シート2」に色つける
 For i = 1 To UBound(myList_2)
    For j = 1 To 100
        If myList_1(i, j) <> myList_2(i, j) Then
           On Error Resume Next
           Sheets_2.Cells(i, j).Interior.Color = 65535
           retMsg = 1
        End If
    Next j
 Next i
     
 'If retMsg = 1 Then
    'MsgBox "差分があります", 48
    
 'Else
    'MsgBox "差分はありません"
 'End If
 
 Set Sheets_1 = Nothing
 Set Sheets_2 = Nothing
  
End Sub

コメント

タイトルとURLをコピーしました