- 締切済み
VBAにてファイル内容比較
VBAにて2つのファイルの内容を比較し、同じかどうかを判断して、同じファイル内容であれば一方を削除するフリーソフトはないでしょうか? また、そのようなことを解説しているサイトがあれば紹介下さい。
- みんなの回答 (3)
- 専門家の回答
みんなの回答
- imogasi
- ベストアンサー率27% (4737/17069)
>B)バイナリデータのようなものか、どうですか。 (B)を考えています。 これで私の手におえませんが(お邪魔しました)、エクセルは表計算ソフトで文字数字情報を扱うソフトであるはず。今でこそセルに画像を貼りつけられるかどうかなど言ってますが。 今後質問される方のために、具体的にどのようなファイルを比較したいのか、例示でもされたらどうでしょう。 まさか画像を比較するとも考えにくい? その際に、「何を以って、2つのファイルの2つのレコードを、比較すべきものとして捉えるか」 の部分に答えて下さい。
- imogasi
- ベストアンサー率27% (4737/17069)
そのファイルは (A)事務や経理などのレコードキーつきか(B)バイナリデータのようなものか、どうですか。 即ち何を以って2つのファイルの2つのレコードを比較すべきものとして捉えるかです。 キーをマッチングさせるとか、出現順序がペアを決めるとかあり得ます。 (A)のタイプなら、情報処理受験の教科書に載っている マッチングのロジックの処理でやればよい。 2つのファイルを同じキーでソートして、比較ルーチンに入ります。 ただmdbファイルはよいが、エクセルファイルは直接読めないですが。 コンピュタ初期の昔は、こればかりやってました。 ファイルが読めれば、コーディングは10数行で出来ますよ。 ---- ソフトを探しているのにVBAと言う言語を指定するのは おかしいのでは。コーディングを参考にしたいと言うことですか。 自分で組むならそのように、質問すべきでは。 VBAと言うからにはアクセス?エクセル?
お礼
アドバイスありがとうございます。 >そのファイルは >(A)事務や経理などのレコードキーつきか(B)バイナリデータのようなものか、どうですか。 (B)を考えています。 >ソフトを探しているのにVBAと言う言語を指定するのは >おかしいのでは。 VBAでどこまでやれるのかが知りたかったのです。 >コーディングを参考にしたいと言うことですか。 ソースが見れればそういうこともあるかもしれません。 >自分で組むならそのように、質問すべきでは。 組むと限定してはいません。 >VBAと言うからにはアクセス?エクセル? エクセルです。
- diashun
- ベストアンサー率38% (94/244)
下記がご参考になるかも。ただしVBAではありません。 http://www.forest.impress.co.jp/library/undup.html
お礼
回答ありがとう御座います。 出来ればVBAでそのようなことが出来るか知りたいので、VBAの紹介をお願いいたします。
お礼
>まさか画像を比較するとも考えにくい? 比較するファイルは画像でも良いし、エクセルでもテキストファイルでも良いです。 >、「何を以って、2つのファイルの2つのレコードを、比較すべきものとして捉えるか」 #1さんの参考サイトにあるようなソフトがエクセルで作れないかということです。 PS 知りたいことは最初の質問の通りです。 それ以上のことを逆に聞かれても答えようが有りません。m(__)m
補足
他サイトで教えていた回答を書いておきます。 '=============================================================== Sub main() Dim flnm If get_two_flnm(flnm) = True Then '二つの比較するファイル名を得る ans = file_comp(flnm) 'ファイルの中身の比較 If ans = 0 Then 判定 = "一致しました" ElseIf ans = 1 Then 判定 = "一致しませんでした" Else 判定 = "エラー発生のため判定できませんでした" End If MsgBox flnm(1) & " と" & vbLf & vbLf & flnm(2) & " は、" & vbLf & vbLf & 判定 End If End Sub '=============================================================== Function get_two_flnm(flnm) As Boolean 'Output : flnm(1)とflnm(2) Dim file_array(1 To 2) Dim ans get_two_flnm = True MsgBox "ファイルを選択して下さい" For idx = 1 To 2 ans = Application.GetOpenFilename() If ans <> False Then file_array(idx) = ans If idx = 1 Then MsgBox "比較するファイル指定して下さい" Else get_two_flnm = False Exit For End If Next idx If get_two_flnm = True Then flnm = file_array() End If End Function '=============================================================== Function file_comp(flnm) As Long 'input :flnm(1) flnm(2) Dim buf As String Dim bt1() As Byte Dim bt2() As Byte Dim flio1 As binio Dim flio2 As binio Dim flsz1 As Long Dim flsz2 As Long Dim f_offset1 As Long Dim f_offset2 As Long file_comp = 0 Set flio1 = New binio Set flio2 = New binio If flio1.open_fl(flnm(1), 1024, flsz1) = 0 And _ flio2.open_fl(flnm(2), 1024, flsz2) = 0 Then If flsz1 = flsz2 Then Do While flio1.get_fl(bt1(), f_offset1) = 0 And _ flio2.get_fl(bt2(), f_offset2) = 0 For idx = LBound(bt1()) To UBound(bt1()) If bt1(idx) <> bt2(idx) Then file_comp = 1 End If Next idx Loop Else file_comp = 1 End If Else file_comp = 2 End If flio1.cls_fl flio2.cls_fl Set flio1 = Nothing Set flio2 = Nothing End Function それからクラスモジュール(クラス名はbinioにしました)に、 '=============================================================== Private flno As Long Private restsz As Long Private buffer As Long '=============================================================== Function open_fl(flnm, buffzs As Long, flsize As Long) As Long On Error Resume Next flno = FreeFile() Open flnm For Binary As #flno open_fl = Err.Number If open_fl = 0 Then restsz = LOF(flno) buffer = buffzs flsize = restsz End If On Error GoTo 0 End Function '=============================================================== Sub cls_fl() On Error Resume Next Close #flno On Error GoTo 0 End Sub '=============================================================== Function get_fl(bt() As Byte, g_idx As Long) As Long ' ↑は、ここでは使ってないけどあると便利そうだから On Error Resume Next Dim readbyte As Long If restsz <= 0 Then get_fl = 1 Else If restsz >= buffer Then readbyte = buffer - 1 Else readbyte = restsz - 1 End If g_idx = Loc(flno) ReDim bt(readbyte) Get #flno, , bt() get_fl = Err.Number If get_fl = 0 Then restsz = restsz - readbyte - 1 End If End If On Error GoTo 0 End Function