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

A 回答 (1件)

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



シートの内容がわからないので前提付です。
(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
    • good
    • 0
この回答へのお礼

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

お礼日時:2002/01/10 14:29

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード


人気Q&Aランキング

おすすめ情報

カテゴリ