OKWAVEのAI「あい」が美容・健康の悩みに最適な回答をご提案!
-PR-
解決
済み

エクセルファイルの比較

  • 暇なときにでも
  • 質問No.188660
  • 閲覧数95
  • ありがとう数1
  • 気になる数0
  • 回答数1
  • コメント数0

お礼率 84% (204/241)

エクセル2000を使用しています。
データーの入ったファイルを100個以上、グラフ化するのですが、作業に入ってから、データーに誤りがあり、幾つか修正し、新しいファイルを送ってもらったのですが、修正した分だけでなく、全ファイル届きました。
旧ファイルのデータと新ファイルのデータがあっているかを比べるようなフリーソフトがあったら教えて下さい。
(更新日時を確認するという方法もありますが、当てにならないので)
通報する
  • 回答数1
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

質問者が選んだベストアンサー

  • 回答No.1
レベル13

ベストアンサー率 68% (791/1163)

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

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

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

ファイルサイズを調べたり、新旧のシートをコピーしてきて照合等をしています。
ファイルサイズ、入力範囲、入力個数、個々のセルの値をチェックしています。
                      (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
お礼コメント
kapakapa

お礼率 84% (204/241)

大変遅くなりましたがご回答ありがとうございます。
なかなか回答がなかったものであきらめておりました。
早速試してみます
投稿日時 - 2002-01-10 14:29:56
-PR-
-PR-
このQ&Aで解決しましたか?
関連するQ&A
-PR-
-PR-
このやり方知ってる!同じこと困ったことある。経験を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
-PR-
-PR-
-PR-

特集


いま みんなが気になるQ&A

関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ