【VBA】 2つのEXCELまたはCSVファイルを比較する

経緯
機能
コード

経緯

職場で山のようなエクセルファイル同士の突き合わせチェックが必要でしたが、
比較ソフトのDL・インストールができない堅い環境だったので、
これまでしかなたくEXCEL内蔵のInquire機能か数式を使って泥臭く作業をしていました。

しかし、エクセルVBAの使用は可能であるため、
今回VBAを利用して自動的にファイルを比較する簡単なコードを組んでみました。

機能

業務で必要な下記の機能を実装します。

2つのファイル(excel, ~~csv~~)をエクスプローラーから開く。
それらのを比較し共通点が多い行を自動で判別して横に並べる。
各行の全セルの差分を出す。

コード

	Option Explicit

	'=========================================================================================
	'メインプロシージャ　その1 (差分確認シート新規作成)
	'=========================================================================================
	Sub MakeDataComparesion()

	Dim columnsCount As Long: columnsCount = 10 '★データ幅(マジックナンバー)
	Dim file1 As Variant, file2 As Variant
	Dim wsNew1 As Worksheet, wsNew2 As Worksheet, wsNew3 As Worksheet

	'■1.初期化(古いシートの削除)
	Call InitializeSheets

	Application.ScreenUpdating = False '画面更新OFF (古いシートの削除後)

	'■2. エクスプローラーからデータ読み込み
	file1 = SelectFile() 'まずは選択
	file2 = SelectFile() 'まずは選択
	Set wsNew1 = LoadData("Data1", file1) '新シート(Data1)を作り、入力データ(file1)を貼付け
	Set wsNew2 = LoadData("Data2", file2) '新シート(Data2)を作り、入力データ(file2)を貼付け

	'■3. 比較用シート作成
	Set wsNew3 = CompareSheet("比較", wsNew1, wsNew2, columnsCount) '新シート(比較)を作り、幅columnsCountの2個のデータ(wsNew1,wsNew2)を並べる。
	Call adjustCompareSheet(wsNew1, wsNew2, wsNew3, columnsCount, 7, 8, 9) 'wsNew1,wsNew2の7,8,9列で差分を見て、比較シート(wsNew3)を調整する。
	Call PutDifFormula(wsNew3.Range("W5:AF200")) '指定範囲に差分判定の数式を配置する。

	Application.ScreenUpdating = True '画面更新OFFを解除

	End Sub


	'=========================================================================================
	'メインプロシージャ　その2 (数式のみ再配置)
	'=========================================================================================

	'差分数式を再配置 (手でセル挿入などすると差分数式の参照セルがズレるので、そのときの修正用)
	Sub RefreshDifFormula()
	Application.ScreenUpdating = False '画面更新OFF

	Dim rng As Range
	Set rng = ThisWorkbook.Sheets("比較").Range("W5:AF200") '※将来的には自動で範囲を取得したい
	Call PutDifFormula(rng)

	Application.ScreenUpdating = True '画面更新ON
	End Sub


	'=========================================================================================
	'↓↓↓↓以下、メインプロシージャーからの呼び出し用↓↓↓↓
	'=========================================================================================
	'------------------------------------------------------
	'①.シート初期化処理 ([引数]なし　　[戻り値]なし)
	Sub InitializeSheets()

	'初期化確認メッセージを表示
	Dim rc As Long
	rc = MsgBox("読み込み済みデータが初期化されます。" & vbCrLf & "続けますか？", vbYesNo + vbQuestion)
	If rc = 7 Then End ' キャンセルが押された場合、処理を終了

	'削除対象シートを取得する
	Dim wsOLD1 As Worksheet, wsOLD2 As Worksheet, wsOLD3 As Worksheet
	On Error Resume Next 'エラーハンドリングを有効にする
	Set wsOLD1 = ThisWorkbook.Sheets("data1")
	Set wsOLD2 = ThisWorkbook.Sheets("data2")
	Set wsOLD3 = ThisWorkbook.Sheets("比較")
	On Error GoTo 0 'エラーハンドリングを元に戻す

	'削除対象シートが存在する場合は削除する
	Application.DisplayAlerts = False 'シート削除確認ダイアログ無効
	If Not wsOLD1 Is Nothing Then wsOLD1.Delete
	If Not wsOLD2 Is Nothing Then wsOLD2.Delete
	If Not wsOLD3 Is Nothing Then wsOLD3.Delete
	Application.DisplayAlerts = True 'シート削除確認ダイアログ無効を解除

	End Sub

	'------------------------------------------------------
	'②入力ファイル選択 ([引数]なし　　[戻り値]選択したファイル)
	Function SelectFile() As Variant
	SelectFile = Application.GetOpenFilename("Excel ファイル (.xls; .xlsx; .xlsm),.xls; .xlsx; .xlsm")
	If SelectFile = "False" Then End ' キャンセルが押された場合、処理を終了
	End Function

	'------------------------------------------------------
	'③入力ファイル読み込み ([引数]作成シート名　　[戻り値]入力データシート)
	Function LoadData(sheetname As String, inputFile As Variant) As Worksheet

	Dim wb As Workbook
	Set wb = Workbooks.Open(inputFile, ReadOnly:=True)

	With ThisWorkbook
	Set LoadData = .Sheets.Add(After:=.Worksheets(.Worksheets.Count))
	LoadData.Name = sheetname
	End With

	wb.Sheets(1).UsedRange.Copy LoadData.Cells(2, 1)
	wb.Close SaveChanges:=False

	'書式設定
	With LoadData
	.Cells.HorizontalAlignment = xlLeft
	.UsedRange.EntireColumn.NumberFormatLocal = "@"
	.UsedRange.EntireColumn.AutoFit
	End With

	'読み込みファイル名を記入(長いので書式設定(セル幅設定)より後に記入)
	LoadData.Cells(1, 1) = inputFile

	End Function

	'------------------------------------------------------
	'④比較シート作成 ([引数]作成シート名, 入力データ1, 入力データ2, データの列数　　[戻り値]比較シート)
	Function CompareSheet(sheetname As String, ws1 As Worksheet, ws2 As Worksheet, columnsCount As Long) As Worksheet

	Dim rng1 As Range, rng2 As Range

	'比較用シートを挿入
	With ThisWorkbook
	Set CompareSheet = .Sheets.Add(After:=.Worksheets(.Worksheets.Count))
	CompareSheet.Name = sheetname
	End With

	'特定の列範囲をコピー
	Set rng1 = ws1.UsedRange ' 例としてA列からJ列までの範囲
	Set rng2 = ws2.UsedRange ' 例としてC列からJ列までの範囲

	rng1.Copy CompareSheet.Cells(1, 1)
	rng2.Copy CompareSheet.Cells(1, columnsCount + 2) ' 左右に並べるため、列数を考慮

	'書式設定
	With CompareSheet
	.Cells.HorizontalAlignment = xlLeft '全セル左寄せ
	.Range(Columns(1), Columns(2 * columnsCount + 2)).NumberFormatLocal = "@" 'データを並べるセルの表示形式
	'.Range("A1:U1").EntireColumn.AutoFit '1行目に長い文字が入るので幅自動調整は行わない
	.Columns(columnsCount + 1).ColumnWidth = 1 '区切りセルその1 幅
	.Columns(columnsCount + 1).Interior.Color = RGB(0, 0, 0) '区切りセルその1 色
	.Columns(2 * columnsCount + 2).ColumnWidth = 1 '区切りセルその2 幅
	.Columns(2 * columnsCount + 2).Interior.Color = RGB(0, 0, 0) '区切りセルその2 色
	End With

	End Function

	'------------------------------------------------------
	'⑤比較シート調整 ([引数]入力データ1, 入力データ2, 比較シート, データの列数)
	Sub adjustCompareSheet(ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, columnsCount As Long, c1 As Long, c2 As Long, c3 As Long)

	Dim rowsCount1, rowsCount2 As Long
	Dim roopN As Long
	Dim CONTENT1_1 As String, CONTENT2_1 As String, CONTENT3_1 As String
	Dim CONTENT1_2 As String, CONTENT2_2 As String, CONTENT3_2 As String
	Dim difFlg1 As Boolean, findFlg1 As Boolean, findFlg2 As Boolean
	Dim i As Long, j As Long

	rowsCount1 = ws1.UsedRange.Rows.Count
	rowsCount2 = ws2.UsedRange.Rows.Count
	roopN = ws3.UsedRange.Rows.Count

	For i = 5 To roopN

	CONTENT1_1 = ws3.Cells(i, c1)
	CONTENT2_1 = ws3.Cells(i, c2)
	CONTENT3_1 = ws3.Cells(i, c3)

	CONTENT1_2 = ws3.Cells(i, c1 + columnsCount + 1)
	CONTENT2_2 = ws3.Cells(i, c2 + columnsCount + 1)
	CONTENT3_2 = ws3.Cells(i, c3 + columnsCount + 1)

	'比較シートの左右比較
	difFlg1 = False
	If CONTENT1_1 <> CONTENT1_2 Then difFlg1 = True
	If CONTENT2_1 <> CONTENT2_2 Then difFlg1 = True
	If CONTENT3_1 <> CONTENT3_2 Then difFlg1 = True

	'比較シートの左右に差分があるとき、必要に応じ行挿入する処理に入る
	If difFlg1 Then

	'「今の行(比較シートDATA1側)」が「DATA2のいずれか」にある？→あったらfindFlg1=Ture
	findFlg1 = 0
	For j = 5 To rowsCount2
	If CONTENT1_1 = ws2.Cells(j, c1) Then
	If CONTENT2_1 = ws2.Cells(j, c2) Then
	If CONTENT3_1 = ws2.Cells(j, c3) Then
	findFlg1 = True
	End If
	End If
	End If
	Next j

	'「今の行(比較シートDATA2側)」が「DATA1のいずれか」にある？→あったらfindFlg2=Ture
	findFlg2 = False
	For j = 5 To rowsCount1
	If CONTENT1_2 = ws1.Cells(j, c1) Then
	If CONTENT2_2 = ws1.Cells(j, c2) Then
	If CONTENT3_2 = ws1.Cells(j, c3) Then
	findFlg2 = True
	End If
	End If
	End If
	Next j

	'findFlg1,find2のどちらかがTureのとき、行挿入し左右を揃える
	If findFlg1 Then
	If Not findFlg2 Then
	ws3.Range(ws3.Cells(i, 1), ws3.Cells(i, columnsCount)).Insert Shift:=xlShiftDown
	ws3.Range(ws3.Cells(i, 1), ws3.Cells(i, columnsCount)).Interior.Color = RGB(200, 220, 220)
	roopN = roopN + 1 'とりあえずループ数を増やす(増加不要のときもあるが、場合分けが面倒なため)
	End If
	Else
	If findFlg2 Then
	Range(ws3.Cells(i, columnsCount + 2), ws3.Cells(i, 2 * columnsCount + 1)).Insert Shift:=xlShiftDown
	Range(ws3.Cells(i, columnsCount + 2), ws3.Cells(i, 2 * columnsCount + 1)).Interior.Color = RGB(200, 220, 220)
	roopN = roopN + 1 'とりあえずループ数を増やす(増加不要のときもあるが、場合分けが面倒なため)
	End If
	End If

	End If
	Next i

	End Sub

	'------------------------------------------------------
	'⑥差分抽出数式配置 ([引数]対象セル範囲)
	Sub PutDifFormula(rng As Range)

	With rng
	.Formula = "=IF(A5=L5, ""〇"", ""×"")"
	.ColumnWidth = 2
	End With

	Dim frmSetting As FormatCondition
	Set frmSetting = rng.FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="×")
	frmSetting.Interior.Color = RGB(255, 70, 0)

	End Sub

	'------------------------------------------------------