やりたいこと
シート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
コメント