Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


12772 / 13644 ツリー ←次へ | 前へ→

【8646】VBAにてファイル内容比較 カド 03/10/28(火) 12:29 質問
【8652】Re:VBAにてファイル内容比較 INA 03/10/28(火) 14:41 回答
【8654】Re:VBAにてファイル内容比較 カド 03/10/28(火) 14:47 お礼
【8658】Re:VBAにてファイル内容比較 INA 03/10/28(火) 14:51 回答
【8667】Re:VBAにてファイル内容比較 カド 03/10/28(火) 16:28 発言
【8669】Re:VBAにてファイル内容比較 INA 03/10/28(火) 16:46 回答
【8677】Re:VBAにてファイル内容比較 カド 03/10/29(水) 7:09 お礼
【8678】Re:VBAにてファイル内容比較 INA 03/10/29(水) 8:41 回答
【8713】Re:VBAにてファイル内容比較 ichinose 03/10/30(木) 1:41 回答
【8752】Re:VBAにてファイル内容比較 カド 03/10/31(金) 8:49 お礼

【8646】VBAにてファイル内容比較
質問  カド  - 03/10/28(火) 12:29 -

引用なし
パスワード
   VBAにて2つのファイルの内容を比較し、同じかどうかを判断して
同じファイル内容であれば一方を削除するフリーソフトはないでしょうか?

また、そのようなことを解説しているサイトがあれば紹介下さい。

日付、ファイル名、ファイルサイズで判断するソフトは有るようですが。。。

PS
簡単にレスが付くと思い他のエクセルのサイトにも質問してしまいましたが、
レスが付きませんでしたので、こちらのVBA専門サイトに改めて質問しました。

両方ともしっかりと応対いたしますので宜しくお願いいたします。

【8652】Re:VBAにてファイル内容比較
回答  INA  - 03/10/28(火) 14:41 -

引用なし
パスワード
   >VBAにて2つのファイルの内容を比較し、同じかどうかを判断して
>同じファイル内容であれば一方を削除するフリーソフトはないでしょうか?

「同じかどうか」の条件は、完全一致ですか?
だとするとかなり難しいと思います。
というより処理時間がとんでもなく長くなると思います。
セル値、書式設定、VBAモジュールなど調べていったら
きりが無いと思います。

その為、ファイルサイズやタイムスタンプで比較する方法が
一般的なのだと思います。

【8654】Re:VBAにてファイル内容比較
お礼  カド  - 03/10/28(火) 14:47 -

引用なし
パスワード
   ▼INA さん:

回答ありがとう御座います。

ファイルはエクセル限定で無く、一般的なファイルを対象に考えています。
ですから、セルで比較するのではなく、バイナリファイル(?良く知りません)で比較することになるのでしょうか。

VBA以外だとこのようなソフトは有りますよね。

【8658】Re:VBAにてファイル内容比較
回答  INA  - 03/10/28(火) 14:51 -

引用なし
パスワード
   >VBA以外だとこのようなソフトは有りますよね。
そのアプリと同じものをEXCEL VBA作りたい。
もしくはEXCEL VBAで作られたものを使用したいということですか?
この理由は何でしょう?

【8667】Re:VBAにてファイル内容比較
発言  カド  - 03/10/28(火) 16:28 -

引用なし
パスワード
   >そのアプリと同じものをEXCEL VBA作りたい。
VBAって結構何でも出来るようなので、こんなことも出来るのか
興味がありました。

>もしくはEXCEL VBAで作られたものを使用したいということですか?
>この理由は何でしょう?
VBAで作られたものが有り、コードが公開されていれば良い勉強に
なると思いました。

【8669】Re:VBAにてファイル内容比較
回答  INA  - 03/10/28(火) 16:46 -

引用なし
パスワード
   ファイル比較のフリーソフトは、たぶんTEXTファイルだけだと思います。
EXCELの内容までは出来ないと思います。

【8677】Re:VBAにてファイル内容比較
お礼  カド  - 03/10/29(水) 7:09 -

引用なし
パスワード
   >ファイル比較のフリーソフトは、たぶんTEXTファイルだけだと思います。
>EXCELの内容までは出来ないと思います。

VBA以外であれば、下記ソフトのようにエクセルファイルだろうが画像だろうが比較できるものはあると思います。(もし、違っていたらm(__)m)

http://www.forest.impress.co.jp/library/undup.html


他の方のレスが付かないところをみるとVBAでは困難なようですね。

いろいろありがとうございました。

【8678】Re:VBAにてファイル内容比較
回答  INA  - 03/10/29(水) 8:41 -

引用なし
パスワード
   ちょっと語弊がありました。
バイナリ比較するものは、textファイルが対象であって、
excelファイルには使用できないと、説明したかったのです。

VBAでtextだけを比較するとか、セル値だけ比較するなら容易ですが、
それ以外は何を比較するのか仕様が決まっていない限り
出来るかどうか分かりません。
だからレスが付かないのだと思います。

【8713】Re:VBAにてファイル内容比較
回答  ichinose  - 03/10/30(木) 1:41 -

引用なし
パスワード
   ▼カド さん:
こんばんは。
ちょっと時間が経ってしまったので、見てないかもしれませんが
作ってみました。見ていたら、確認してみて下さい。
標準モジュールに
'===============================================================
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

何回かテストしましたが、それらしく動いていました。

【8752】Re:VBAにてファイル内容比較
お礼  カド E-MAIL  - 03/10/31(金) 8:49 -

引用なし
パスワード
   ▼ichinose さん 回答ありがとう御座いました。

>ちょっと時間が経ってしまったので、見てないかもしれませんが
>作ってみました。見ていたら、確認してみて下さい。

こんなすごい回答が来てたのに見過ごすところでした。
やはりVBAは何でも出来るのですね。すばらしいです。

12772 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free