Excel VBAを使用して、ファイル間でデータ不一致箇所を見つける

Excel VBAを使えば、複数のファイル間でデータを比較し、異なる箇所を目立つように着色することができます。この記事では、実際のサンプルアプリを紹介しながら、下記のサンプルコードの処理内容を詳しく説明します。

サンプルアプリの紹介と説明

このサンプルアプリは、Excel VBAを使用して2つのファイルのデータを比較し、違う値の箇所を着色する機能を提供します。
比較元のデータが格納されたExcelファイルから比較先のExcelファイルを選択することで、両者のデータを比較し、異なるセルを特定の色でハイライト表示します。
サンプルアプリ内の下記「データを比較する」ボタンをクリックすると、比較先ファイルを選択できるダイアログ画面が表示されますので、該当ファイルを選択して「開く」をクリックすると異なっているデータのセルを着色します。

サンプルコードの処理内容

次項に掲載しているサンプルコードは、データ比較と着色を行うためのVBAマクロです。コードの処理内容を説明します。

マクロを実行するExcelファイルを読み込み元ブックとして設定し、カレントフォルダのパスを変更します。
　　　　↓
ダイアログを表示して、比較先のExcelファイルを選択します。
キャンセルされた場合は処理を終了します。
　　　　↓
読み込み元ブックから指定されたシート（"Sheet1″）を設定し、選択します。
　　　　↓
前回の処理内容をリセットするため、読み込み元シートのセルの着色箇所をクリアします。
　　　　↓
比較先のExcelファイルを読み込み、データ比較先のシート（"Sheet1″）を取得して設定します。
　　　　↓
読み込み元シートと比較先シートのデータをセルごとに比較し、異なる場合にセルを着色します。
　　　　↓
読み込み先のExcelファイルを保存せずに閉じ、参照をクリアします。
　　　　↓
読み込み元のシートを選択し、マクロの実行を終了します。

サンプルコード　　　アプリの作成手順はこちら

下記のコードは、読み込み元と比較先のExcelファイルのデータを比較し、異なるセルを着色して表示する機能を提供します。
このコードを使用することで、大量のデータが含まれる複数のファイルを効率的に比較し、異なる箇所を視覚的に特定することができます。
カレントフォルダのパスを取得ための関数の詳細については、下記リンク先をご覧ください。
　　https://scodebank.com/?p=696

Option Explicit

Sub データ比較()

Dim wa As Workbook      '読込み元ブック名を格納する変数
Dim wah As Worksheet    '読込み元シート名を格納する変数
Dim wb As Workbook      '読込み先ブック名を格納する変数
Dim wbh As Worksheet    '読込み先シート名を格納する変数
Dim fn As String        '読込み先ファイルのパスを格納する変数
Dim cell As Range       'セルの範囲を格納する変数

'読込み元ブックのオブジェクトをセット
Set wa = ThisWorkbook

'カレントフォルダにパスを変更
ChDir UrlToLocal(ThisWorkbook.Path)

'読込み先Excelファイルをダイアログから選択して、選択したファイルパスを格納する。
fn = Application.GetOpenFilename(("Excel ファイル (*.xlsm), *.xlsm"), , "ブックを選択して下さい。")

'ファイル選択をキャンセルした場合の処理
If fn = "False" Then
  MsgBox "キャンセルしました。"
  Exit Sub
End If

'読込み元シートを変数にセット
Set wah = wa.Worksheets("Sheet1")

'シートを選択
wah.Select

'セル着色箇所をクリア
wah.UsedRange.Interior.ColorIndex = xlNone

'比較先シートの取得
Set wb = Workbooks.Open(Filename:=fn, UpdateLinks:=0) '警告を出さずリンクを更新して開きwbとする
'（UpdateLinks:=0 にすると、リンクを更新せずに開きます。）

'比較先シートを変数にセット
Set wbh = wb.Worksheets("Sheet1")

'データを比較して異なっていればセルを着色
For Each cell In wah.UsedRange
  If Not cell.Value = wbh.Cells(cell.Row, cell.Column).Value Then
　　'異なるセルを着色（ここでは色インデックス6「黄色」を使用）
    cell.Interior.ColorIndex = 6
  End If
Next cell

'警告を出さず保存しないで読込先のファイルを終了
wb.Close (False)

'読込先ファイルをクリア
Set wb = Nothing

'読込み元ファイルのシートを選択
wah.Select

End Sub

'*********************************************************************************************

'カレントフォルダのパスを取得ための関数
Public Function UrlToLocal(ByRef Url As String) As String

   'OneDrive環境変数を格納する変数の定義
    Dim OneDrive As String

   'OneDrive環境変数の取得
    OneDrive = Environ("OneDrive")

   '「https://･･･････/Documents」までの文字数を格納する変数の定義
    Dim CharPosi As String

   ' ＵＲＬからローカルパスを作成する
    If Url Like "https://*" Then 'OneDriveのパスかどうかの判定
           
      '「https://･･･････/Documents」までの文字数を取得
      CharPosi = InStr(1, Url, "/Documents") + 10
      
      'ローカルパス作成
      Url = OneDrive & Replace(Mid(Url, CharPosi), "/", Application.PathSeparator)
    
    Else
    
      'OneDriveのパス以外だったらカレントドライブ指定
      ChDrive Left(Url, 1)
     
    End If

  '作成したローカルパスを返す
   UrlToLocal = Url

End Function

VBA,セルの操作,ループ処理,検索処理Excel,VBA,データ比較,マクロ

Posted by CoderM