こんなのではどうでしょうか?
両フォルダには同じ名前のExcelファイル(各シート数も同じ)があるとして、片方からだけ見てます。
同名のブックを開けないので作業フォルダに別名でコピーして作業をして戻してます。(これが結構長くしてる)
Const workFolder ="???"を適当に設定してください。
シートのチェックはUsedRange内のチェックをしてます。
さすがにこれは片方からだけとはいかないので両方からチェックしてます。
当然ダブってチェックする部分がほとんどですが・・・処理が長くなりそうなのでダブり部分のチェックはしません。
かわりに作業の進行状況をステータスバーに表示しますので、シートにボタンを作って、ボタンのクリックからsampleを呼んでみてください。
Option Explicit
Const workFolder = "c:\temp" '適当な作業フォルダを設定してください。
Sub sample()
  Dim srcFolder As String
  Dim dstFolder As String
  srcFolder = "c:\test\a" 'フォルダA
  dstFolder = "c:\test\b" 'フォルダB
  
  Dim fso As New FileSystemObject
  Dim srcFile As String
  Dim dstFile As String
  Dim srcWorkFile As String
  Dim dstWorkFile As String
  Dim f As File
  Dim n As Integer  '進行状況表示用
  Dim i As Integer  '進行状況表示用
  '表示設定
  Application.DisplayStatusBar = True 'ステータスバー表示
  Application.ScreenUpdating = False  '画面更新禁止
  '作業ファイル名
  srcWorkFile = workFolder & "\src.xls"
  dstWorkFile = workFolder & "\dst.xls"
  n = fso.GetFolder(srcFolder).Files.Count
  For Each f In fso.GetFolder(srcFolder).Files
    i = i + 1
    If f Like "*.xls" Then
      'srcFolderのファイルと同じ名前のファイルがdstFolderにもあるとする
      srcFile = srcFolder & "\" & f.Name
      dstFile = dstFolder & "\" & f.Name
      'ステータスバー表示
      Application.StatusBar = srcFile & " と " & dstFile & " を、チェック中 (" & i & "/" & n & ")"
      '作業フォルダにファイルをコピー
      fso.CopyFile srcFile, srcWorkFile, True
      fso.CopyFile dstFile, dstWorkFile, True
      'ブックチェック
      checkBook srcWorkFile, dstWorkFile
      '作業フォルダのファイルを戻す
      fso.CopyFile srcWorkFile, srcFile, True
      fso.CopyFile dstWorkFile, dstFile, True
    End If
  Next
  '作業ファイルを削除
  fso.DeleteFile srcWorkFile
  fso.DeleteFile dstWorkFile
  '後始末
  Set fso = Nothing
  Application.ScreenUpdating = True
  Application.StatusBar = False
End Sub
'ブック(ファイル)のチェック
Sub checkBook(srcFile As String, dstFile As String)
  Dim srcBook As Workbook
  Dim dstBook As Workbook
  Dim ws As Worksheet
  Set srcBook = Workbooks.Open(srcFile)
  Set dstBook = Workbooks.Open(dstFile)
  'srcBookのシート名と同じシートがdstBookにもあるとしてチェック
  For Each ws In srcBook.Worksheets
    checkSheet ws, dstBook.Worksheets(ws.Name)
  Next
  srcBook.Close savechanges:=True
  dstBook.Close savechanges:=True
End Sub
'シートのチェック
Sub checkSheet(srcSheet As Worksheet, dstSheet As Worksheet)
  '背景色のクリア
  srcSheet.Cells.Interior.ColorIndex = xlNone
  dstSheet.Cells.Interior.ColorIndex = xlNone
  '両方のUsedRange範囲内で変更点をチェック
  'ダブってチェックする部分が多いけれど
  checkSheetUsedRange srcSheet, dstSheet
  checkSheetUsedRange dstSheet, srcSheet
End Sub
'シートのチェック(srcSheetのUsedRange内)
Sub checkSheetUsedRange(srcSheet As Worksheet, dstSheet As Worksheet)
  Dim r As Range
  For Each r In srcSheet.UsedRange
    If r <> dstSheet.Range(r.Address) Then
      r.Interior.ColorIndex = 3
      dstSheet.Range(r.Address).Interior.ColorIndex = 3
    End If
  Next
End Sub      
                        
        投稿日時 - 2008-04-18 02:07:40