エクセルファイルの比較

質問

エクセル2000を使用しています。
データーの入ったファイルを１００個以上、グラフ化するのですが、作業に入ってから、データーに誤りがあり、幾つか修正し、新しいファイルを送ってもらったのですが、修正した分だけでなく、全ファイル届きました。
旧ファイルのデータと新ファイルのデータがあっているかを比べるようなフリーソフトがあったら教えて下さい。
（更新日時を確認するという方法もありますが、当てにならないので）

回答No.1

nishi6 · ベストアンサー

それらしきソフトもないようだし、回答も無いので作ってみました。

シートの内容がわからないので前提付です。
（１）今は各Bookのシート1(シート名：Sheet1)を対象としています。
（２）最初の100個以上のファイルを特定のフォルダに入れます。
（３）修正された100個以上のファイルを別のフォルダに入れます。
（４）新しいファイルと古いファイルは同じファイル名で、個数は同じとしています。

検証するためのBookを作ります。
（１）新規BoookでSheet1のみにします。他は削除。
（２）下記のコードをVBEの標準モジュールに貼り付けます。
　　　　　　ツール→マクロ→Visual Basic Editor でVBE画面に移り、
　　　　　　挿入→標準モジュール　で標準モジュールを挿入します。
（３）モジュールの『***』部分を（２）、（３）のフォルダ名に変更します。
（４）シートに戻り、ツール→マクロ→マクロ　でSheetCheckを実行します。
照合結果をシート１に書き出します。

ファイルサイズを調べたり、新旧のシートをコピーしてきて照合等をしています。
ファイルサイズ、入力範囲、入力個数、個々のセルの値をチェックしています。
　　　　　　　　　　　　　　　　　　　　　　（Excel2000で動作確認しました）

↓ここから
Dim TargetBook As String　　　　　　　　　　　　　　'変更の有無を調べるBookの1つ
Dim myBookname As String　　　　　　　　　　　　　　'このブック
Const srcForder = "D:\000work_xls\0005\Hikaku1"　　　'***　元のブックがあるフォルダ
Const chgForder = "D:\000work_xls\0005\Hikaku2"　　　'***　変更後のブックがあるフォルダ

Public Sub SheetCheck()
　　Dim srcCheckArea, chgCheckArea As Range　　　　　'元のシートと変更後シートの入力範囲
　　Dim chgRg As Range　　　　　　　　　　　　　　　'変更後シートのセル
　　Dim ws1 As Worksheet　　　　　　　　　　　　　　'結果出力するシート1
　　Dim rw As Long　　　　　　　　　　　　　　　　　'シート1の行カウンタ

　　Application.ScreenUpdating = False

　　Set ws1 = Worksheets("Sheet1")
　　myBookname = ThisWorkbook.Name

　　TargetBook = Dir(chgForder & "\" & "*.xls")
　　While Len(TargetBook) > 0
　　　　rw = rw + 1: ws1.Range("A" & rw) = TargetBook
　　　　'シートをコピーする
　　　　SheetCopy srcForder, "srcSheet"　　　　'最初のブックからSheet1をコピー
　　　　SheetCopy chgForder, "chgSheet"　　　　'変更されているかもしれないブックからSheet1をコピー

　　　　'各シートの使用範囲を定義
　　　　Set srcCheckArea = Worksheets("srcSheet").UsedRange
　　　　Set chgCheckArea = Worksheets("chgSheet").UsedRange

　　　　'内容をチェック
　　　　If FileLen(srcForder & "\" & TargetBook) <> FileLen(chgForder & "\" & TargetBook) Then
　　　　　　ws1.Range("B" & rw) = "ファイルサイズが異なります"　　　　'ファイルサイズのチェック
　　　　ElseIf srcCheckArea.Address <> chgCheckArea.Address Then　　　'入力範囲のチェック
　　　　　　ws1.Range("B" & rw) = "入力範囲の変更あり"
　　　　ElseIf srcCheckArea.Count <> chgCheckArea.Count Then　　　　　'データ数のチェック
　　　　　　ws1.Range("B" & rw) = "データ数の変更あり"
　　　　Else　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'個々のセルのチェック
　　　　　　For Each chgRg In chgCheckArea
　　　　　　　　If chgRg.Text <> Worksheets("srcSheet").Range(chgRg.Address).Text Then
　　　　　　　　　　ws1.Range("B" & rw) = "データ値の変更あり"
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next
　　　　End If

　　　　Application.DisplayAlerts = False 'シートを削除
　　　　Sheets("chgSheet").Delete
　　　　Sheets("srcSheet").Delete

　　　　'次のブック
　　　　TargetBook = Dir
　　Wend

　　ws1.Select
　　Application.ScreenUpdating = True
End Sub

'シートをコピーしてシート名を変更する(Copyの前のSheet1が対象シート)
Public Sub SheetCopy(xlsFolder As String, newSheetName As String)
　　Workbooks.Open Filename:=xlsFolder & "\" & TargetBook
　　'シート1をコピー。最初のSheet1がデータファイルのSheet1
　　Sheets("Sheet1").Copy After:=Workbooks(myBookname).Sheets(1)
　　Sheets("Sheet1 (2)").Name = newSheetName
　　Windows(TargetBook).Activate
　　ActiveWindow.Close
End Sub

お礼

大変遅くなりましたがご回答ありがとうございます。
なかなか回答がなかったものであきらめておりました。
早速試してみます