2つのExcelファイルを比較して差分チェック

質問

表記の件について質問です。2つのExcelファイル（新旧）があるとします。

新ファイルのA列（最初の行は項目名なので無視）の2行目の値を旧ファイルの同じくA列2行目から空白が見つかるまでのセル範囲内を検索し、ヒットしたら横の行を比較して差分があればセルを塗潰しします。塗潰しするのはあくまでも新ファイルとしたいです。
※新ファイルに含まれて旧ファイルに含まれないものも赤色で塗潰し。逆に新ファイルになくて旧ファイルにあるものは敢えて抜き出す必要はありません。

Option Explicit '変数を定義しないとエラーとする宣言

'定数の宣言
'Const 定数名 [As データ型] = "定数の値"
Const workFolder = "c:\temp"

Sub sample()
'Dimステートメントで変数の定義
Dim srcFolder As String
Dim dstFolder As String
srcFolder = "c:\test\a" 'フォルダＡ
dstFolder = "c:\test\b" 'フォルダＢ

'Excelからファイルを操作するためのファイルオブジェクト
Dim fso As New FileSystemObject
Dim srcFile As String
Dim dstFile As String
Dim srcWorkFile As String
Dim dstWorkFile As String
Dim f As File
Dim n As Integer '進行状況表示用
Dim i As Integer '進行状況表示用

'表示設定
'ステータスバーの表示
Application.DisplayStatusBar = True
'編集中の画面描画を禁止
Application.ScreenUpdating = False
'作業ファイル名を指定
srcWorkFile = workFolder & "\src.xls"
dstWorkFile = workFolder & "\dst.xls"

'GetFolderオブジェクトはフォルダからFolderオブジェクトを作成するメソッドでフォルダの操作やフォルダの詳細情報の取得が行える。
'GetFolderオブジェクトのFilesプロパティ、FilesコレクションのCountプロパティでフォルダ内のファイル数を取得する。
n = fso.GetFolder(srcFolder).Files.Count

For Each f In fso.GetFolder(srcFolder).Files
i = i + 1
If f Like "*.xlsx" Then
'srcFolderのファイルと同じ名前のファイルがdstFolderにもあるとする
srcFile = srcFolder & "\" & f.Name
dstFile = dstFolder & "\" & f.Name
'ステータスバー表示
Application.StatusBar = srcFile & " と " & dstFile & " を、チェック中 (" & i & "/" & n & ")"
'作業フォルダにファイルをコピー
fso.CopyFile srcFile, srcWorkFile, True
fso.CopyFile dstFile, dstWorkFile, True
'ブックチェック
checkBook srcWorkFile, dstWorkFile
'作業フォルダのファイルを戻す
fso.CopyFile srcWorkFile, srcFile, True
fso.CopyFile dstWorkFile, dstFile, True
End If
Next
'作業ファイルを削除
fso.DeleteFile srcWorkFile
fso.DeleteFile dstWorkFile
'後始末
Set fso = Nothing
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

'ブック(ファイル)のチェック
Sub checkBook(srcFile As String, dstFile As String)
Dim srcBook As Workbook
Dim dstBook As Workbook
Dim ws As Worksheet
Set srcBook = Workbooks.Open(srcFile)
Set dstBook = Workbooks.Open(dstFile)
'srcBookのシート名と同じシートがdstBookにもあるとしてチェック
For Each ws In srcBook.Worksheets
checkSheet ws, dstBook.Worksheets(ws.Name)
Next
srcBook.Close savechanges:=True
dstBook.Close savechanges:=True
End Sub

'シートのチェック
Sub checkSheet(srcSheet As Worksheet, dstSheet As Worksheet)
'背景色のクリア
srcSheet.Cells.Interior.ColorIndex = xlNone
dstSheet.Cells.Interior.ColorIndex = xlNone

'両方のUsedRange範囲内で変更点をチェック
checkSheetUsedRange srcSheet, dstSheet
checkSheetUsedRange dstSheet, srcSheet End Sub

'シートのチェック（srcSheetのUsedRange内）
Sub checkSheetUsedRange(srcSheet As Worksheet, dstSheet As Worksheet)
Dim r As Range
For Each r In srcSheet.UsedRange
If r <> dstSheet.Range(r.Address) Then
r.Interior.ColorIndex = 3
dstSheet.Range(r.Address).Interior.ColorIndex = 3
End If
Next
End Sub

上記マクロのシートのチェックですと、差分が見つかるとそれ以降全て差分ありと判断されてしまい思うような結果を得られません。

回答No.1

eden3616

コードの直接的な回答ではありません。
行・列の増減を考慮にいれたコードを記述しないと、ご質問のような問題点に直面します。
テキストデータの差分を抽出する際は通常diffというロジックを使用します。

参考
https://ja.wikipedia.org/wiki/Diff
http://dsp74118.blogspot.jp/2013/12/vba-exceldiff.html

また、Excelの２ファイルにおいて差分を抽出するツールはベクターなどでフリーソフトで公開されていますので、ご検討されてはどうでしょうか。

エクセル差分比較ツール
http://www.vector.co.jp/soft/winnt/business/se492955.html
エクセル比較
http://www.vector.co.jp/soft/win95/business/se412925.html