一問一答の一歩

仕事をするにおいて、ファイルをコピーして操作した場合には、時々ファイルが一致していることを確かめたくなることがあります。

そのため2つのエクセルファイルのシートの差分を比較して、一致することを確認するためのVBAマクロのプログラムを作成したので、共有しておきます。

前提1:比較する2つのエクセルファイルを開いた状態で実行することを前提とします

前提2:違っているセルがあれば、そのセルの背景を黄色く染めます

前提3また、エクセルシートに以下のセルに下記の情報を記載することを前提にしています。

• 4D……変更前エクセルシートのブック名
• 4E……変更後エクセルシートのブック名
• 5D……変更前エクセルシートのブック名
• 5E……変更後エクセルシートのブック名

コードは以下の通りです。

Sub Check_differentcell
---------------------------------
'概要:二つのシートを比較し、違っているセルがあったら黄色く染める
'機能名:Check_differentcell
'引数:なし
'戻り値:なし
'備考:
--------------------------------

Dim beforeSheet As Worksheet
Dim afterSheet As WorkSheet
Dim optional_sheet As Worksheet
Dim beforebook_name As String
Dim afterbook_name As String
Dim beforeSheet_name As String
Dim afterSheet_name As String
DIm row_number As Integer
DIm column_number As Integer

Set optional_sheet = Workbooks("Sheet1")
'4Dのセルを参照(4Dにブック名を入力する)
beforebook_name=optional_sheet.Cells(4,4).Value
'4Eのセルを参照(4Eにブック名を入力する)
afterbook_name=optional_sheet.Cells(4,5).Value
'5Dのセルを参照(5Dにシート名を入力する)
beforesheet_name=optional_sheet.Cells(5,4).Value
'5Eのセルを参照(5Eにシート名を入力する)
aftersheet_name=optional_sheet.Cells(5,5).Value

Set beforesheet = Workbooks(beforebook_name).Worksheets(beforesheets_name)
Set aftersheet = Workbooks(afterbook_name).Worksheets(aftersheets_name)
'変更前シートの最初から最後の行、列の数まで繰り返す
For row_number=1 To beforesheet.Cells(Rows.Count,1).end(xlup).Row
	For column_number=1 to beforesheet.Cells(1,Columns.Count).End (xlToleft).Column
		'変更後シートが変更前シートの値と異なっていた場合、セルを黄色く染める
		If beforeSheet.Cells(row_number,column_number).Vaule<>aftersheet.Cells(row.number,column.number).Value Then
			aftersheet.Cells(row_number,column_number).Interior.Color=RGB(255,255,0)
		End If
	Next column_number
Next row_number
End Sub