エクセルのファイル内データ比較

質問

データがエクセルファイルなのでここで質問いたします．
エクセルファイルが３００個ぐらいあります．
この中で基本になるファイルは５０個ぐらいあります．
その５０個のファイルの１つと残り２５０個ぐらいのファイル内データを比較できる方法はないでしょうか？
当然一気に比較する方法ではなくてもかまいません．
現在１つ１つ開いて見て比較する途方もない作業で死にそうです．
ファイル内データはマクロもなければ計算式すらありません．
数字データがA1～A90，B1～B90まで入っています．
データ数は全ファイル共通となっています．
どなたか良い知恵を授けてください．お願いします．

回答No.1

ARC · ベストアンサー

とりあえず、ファイル名固定と考えて、VBAを使わずに行うのなら、リンク貼り付けを利用すればいいですね。

1:ファイルを新規作成する。(以下、[比較1])

2:基本となるファイル(５０個ほどあるやつ)を一つ開く(以下、[基準1])

3:比較対象のファイル(２５０個の方)をとりあえず一つ開く(以下、[対象1]

4:[基準1]のA1:B90 の範囲をコピーし、[比較1]のA2:B91にでもリンク貼り付けします。(A2を選択して、[編集]-[形式を指定して貼り付け]-[リンク貼り付け]) A1のセルには、適当にキャプションを付ける。

5:[対象1]のA1:B90をコピー、[比較1]のG2:H91にでもリンク貼り付けする。

6:次の比較対象のファイル[対象2]を開き、A1:B90を[比較1]のI2:J91にリンク貼り付けする。
以下同様に他の比較対象ファイルも処理する。
列が足りなくなったら、Sheet2にでも貼り付けする。この際、Sheet1と同じレイアウトにしておくと、何かと楽。

****ここまでは準備。 ここから比較作業****

7:G列を選択し、書式-条件付書式で、「数式が」「=(G1<>$A1)」を指定し、目立つような書式(例えば背景が赤とか)を設定する。

8:同様に、H列も「数式が」「=(H1<>$B1)」にして、条件付書式を設定。

9:G:Hを選択し、コピー、I:J列を選択し、「形式を指定して貼り付け」で書式のみを貼り付ける。同様にG:Jの書式をK:Nに貼り付けて・・以下同様

以上の操作で、基準データと異なるものだけがハイライト表示されるはずです。

それとか、C2のセルに
=(A2<>G2)+(A2<>I2)+(A2<>K2)+・・・
ってすると、A2と異なるデータの個数が求められますね。

10:このファイルを複製して、他の基準データに対応したものも作成する。[比較2],[比較3](A列、B列のデータだけ変えればいいです。)

これで解決できますか？何かあったら、補足してください。

お礼

ありがとうございます．
すごいです．
ＤＯＳレベルで簡単に考えてましたが
エクセルのファイル比較はこのようにやるのですか．
参考させていただきます．

回答No.3

nishi6

前の回答と同様の前提です。
横に５０余りのBook、縦に２５０余りのBookのSheet1のセル内容を取り込みます。AB列それぞれで比較しています。
各シートの差の絶対値を計算・表示し、シート単位のＡ・Ｂ列の絶対値計を計算し、ゼロでなければ青く色が付きます。

実際、３００余りのBookでどの位時間がかかるか不明です。３００Bookを一括処理が可能かも不明です。
基本３Book、比較対象６Bookで数秒です。(こちらはPentium120、32MB (;o;)とかなり遅い！ )
数Bookでテストして見て下さい。けっこうおもしろい問題でした。

標準モジュールに貼り付けます。
Public Sub SheetsHikakuCell()
　Dim MainFolder As String, MainExcel As String, MainBookNum As Integer ' 50シートのフォルダ,ファイル名,数
　Dim Sub_Folder As String, Sub_Excel As String, Sub_BookNum As Integer '250シートのフォルダ,ファイル名,数 '

　Dim myBookName As String '集計用ブック名
　　myBookName = ThisWorkbook.Name
　Dim sht1 As Worksheet '集計用シート
　Dim rg As Range '集計用シートのA1
　Set sht1 = Worksheets("Sheet1")
　Set rg = sht1.Range("A1")

　MainFolder = "C:\benkyo\Main" '<=== 変更して下さい
　Sub_Folder = "C:\benkyo\Sub" '<=== 変更して下さい

　Application.ScreenUpdating = False

　' 50シートの方を読む。
　MainExcel = Dir(MainFolder & "\" & "*.xls")
　While MainExcel <> ""
　　Workbooks.Open MainFolder & "\" & MainExcel
　　　MainBookNum = MainBookNum + 1

　　　Workbooks(myBookName).Activate
　　　　With Worksheets("Sheet1").Range("A1")
　　　　　.Offset(0, MainBookNum * 4) = MainExcel
　　　　　Workbooks(MainExcel).Worksheets("Sheet1").Range("A1:B90").Copy _
　　　　　　　Destination:=.Offset(0, MainBookNum * 4 + 1)
　　　　End With
　　　　Workbooks(MainExcel).Close

　　MainExcel = Dir
　Wend

　'250シートの方を読む。
　Sub_Excel = Dir(Sub_Folder & "\" & "*.xls")
　While Sub_Excel <> ""
　　Workbooks.Open Sub_Folder & "\" & Sub_Excel
　　　Sub_BookNum = Sub_BookNum + 1

　　　Workbooks(myBookName).Activate
　　　　With Worksheets("Sheet1").Range("A1")
　　　　　.Offset(Sub_BookNum * 100, 0) = Sub_Excel
　　　　　Workbooks(Sub_Excel).Worksheets("Sheet1").Range("A1:B90").Copy _
　　　　　　　Destination:=.Offset(Sub_BookNum * 100, 1)
　　　　End With
　　　　Workbooks(Sub_Excel).Saved = True
　　　　Workbooks(Sub_Excel).Close

　　Sub_Excel = Dir
　Wend

　Dim rwCot As Integer
　With Worksheets("Sheet1").Range("A1")
　　'ファイル名のコピー
　　.Offset(100, 4).Formula = "=E1"
　　'A列の差額計算式
　　For rwCot = 1 To 90
　　　.Offset(99 + rwCot, 5).Formula = "=Abs(F$" & rwCot & "-$B" & (100 + rwCot) & ")"
　　Next
　　'B列の差額計算式
　　For rwCot = 1 To 90
　　　.Offset(99 + rwCot, 6).Formula = "=Abs(G$" & rwCot & "-$C" & (100 + rwCot) & ")"
　　Next
　　'A列差の絶対値計
　　.Offset(102, 4) = "A列差の絶対値計"
　　.Offset(103, 4).Formula = "=Sum(F101:F190)"
　　.Offset(103, 4).FormatConditions.Delete '条件付き書式を設定
　　.Offset(103, 4).FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="0"
　　.Offset(103, 4).FormatConditions(1).Interior.ColorIndex = 8
　　'B列差の絶対値計
　　.Offset(105, 4) = "B列差の絶対値計"
　　.Offset(106, 4).Formula = "=Sum(G101:G190)"
　　.Offset(106, 4).FormatConditions.Delete '条件付き書式を設定
　　.Offset(106, 4).FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="0"
　　.Offset(106, 4).FormatConditions(1).Interior.ColorIndex = 8
　End With

　'差額の式をコピー
　Dim mn, sb As Integer 'Bookカウンタ
　Range("E101:G190").Copy
　For mn = 1 To MainBookNum
　　For sb = 1 To Sub_BookNum
　　　Range("E101").Offset((sb - 1) * 100, (mn - 1) * 4).Select
　　　ActiveSheet.Paste
　　Next
　Next

　Application.ScreenUpdating = True

End Sub

お礼

ありがとうございます．
プログラムも書いて頂き
大変恐縮です．
うまく行きそうです．

回答No.2

nishi6

＞ファイル内データを比較できる方法はないでしょうか？
この意味はセル単位で比較し、セル単位に差額を表示したりすることでしょうか。それも一応作りましたが・・・まだ未完成。

下記は、シート５０余りと、２５０余りのシートのＡＢ列の内容を比較し、シート単位で一致しているか判定を表示します。質問の意味と異なっていれば補足してください。それから、比較結果の出力方法も補足してもらえればと思います。

前提　　５０余りのシートを１つのフォルダに集めます。
　　　　　　MainFolder = "・・・・・・" をそのドライブ、フォルダにします。
　　　２５０余りのシートを１つのフォルダに集めます。（５０余りとは別フォルダ）
　　　　　　Sub_Folder = "・・・・・・" をそのドライブ、フォルダにします。
　　　比較対象のブック以外は入れないで下さい。
　　　各データはSheet1(シート名)に入っていると仮定しています。

出力　横に５０余りのシート名、縦に２５０余りのシート名を表示してＡ，Ｂ列毎に
　　　一致していれば『○』、異なっていれば『×』を表示します。

なにせシート数が多いので数シートずつにしてテストして見て下さい。　

標準モジュールに貼り付けて下さい。

Public Sub SheetsHikaku()
　Dim MNdt() As Double ' 50シートの方の値
　Dim SBdt(1, 90) As Double '250シートの方の値
　Dim Sagaku(2) As Double 'A,B列の差
　Dim rw, cl, bk As Integer '行,列,ブックのカウンタ
　Dim MainFolder As String, MainExcel As String, MainBookNum As Integer ' 50シートのフォルダ,ファイル名,数
　Dim Sub_Folder As String, Sub_Excel As String, Sub_BookNum As Integer '250シートのフォルダ,ファイル名,数 '
　Dim myBookName As String '集計用ブック名

　Dim sht1 As Worksheet '集計用シート
　Dim rg As Range '集計用シートのA1
　Set sht1 = Worksheets("Sheet1")
　Set rg = sht1.Range("A1")

　MainFolder = "C:\benkyo\Main" ' <=== 変更して下さい
　Sub_Folder = "C:\benkyo\Sub" ' <=== 変更して下さい
　myBookName = ThisWorkbook.Name

　Application.ScreenUpdating = False

　' 50シートの方を読む。MNdt()に格納
　MainExcel = Dir(MainFolder & "\" & "*.xls")
　While MainExcel <> ""
　　Workbooks.Open MainFolder & "\" & MainExcel
　　　MainBookNum = MainBookNum + 1
　　　rg.Offset(0, (MainBookNum - 1) * 2 + 1) = MainExcel '表題を書く
　　　rg.Offset(1, (MainBookNum - 1) * 2 + 1) = "Ａ列"
　　　rg.Offset(1, (MainBookNum - 1) * 2 + 2) = "Ｂ列"

　　　ReDim Preserve MNdt(1, 90, MainBookNum)
　　　With Workbooks(MainExcel).Worksheets("Sheet1").Range("A1")
　　　　For cl = 1 To 2
　　　　　For rw = 1 To 90
　　　　　　MNdt(cl - 1, rw, MainBookNum) = .Offset(rw - 1, cl - 1)
　　　　　Next
　　　　Next
　　　End With
　　Workbooks(MainExcel).Close

　　'次のブック
　　MainExcel = Dir
　Wend

　'250シートの方を読む。SBdt()に格納
　Sub_Excel = Dir(Sub_Folder & "\" & "*.xls")
　While Sub_Excel <> ""
　　Workbooks.Open Sub_Folder & "\" & Sub_Excel
　　　Sub_BookNum = Sub_BookNum + 1
　　　rg.Offset(Sub_BookNum + 1, 0) = Sub_Excel '表題を書く
　　　With Workbooks(Sub_Excel).Worksheets("Sheet1").Range("A1")
　　　　For cl = 1 To 2
　　　　　For rw = 1 To 90
　　　　　　SBdt(cl - 1, rw) = .Offset(rw - 1, cl - 1)
　　　　　Next
　　　　Next
　　　End With
　　Workbooks(Sub_Excel).Close

　　'データの比較
　　For bk = 1 To MainBookNum
　　　For cl = 1 To 2
　　　　Sagaku(cl) = 0
　　　　For rw = 1 To 90
　　　　　Sagaku(cl) = Sagaku(cl) + Abs(MNdt(cl - 1, rw, bk) - SBdt(cl - 1, rw))
　　　　Next
　　　　If Sagaku(cl) > 0 Then '比較結果を書く
　　　　　rg.Offset(Sub_BookNum + 1, (bk - 1) * 2 + cl) = "×"
　　　　Else
　　　　　rg.Offset(Sub_BookNum + 1, (bk - 1) * 2 + cl) = "○"
　　　　End If
　　　Next
　　Next

　　'次のブック
　　Sub_Excel = Dir
　Wend

　Application.ScreenUpdating = True

End Sub