EXCEL VBA

Excel-VBA 実例 シートの内容を比較して異なる部分を出力

EXCEL VBA

こんにちは! 健史(たけふみ)です。

Excelシートで、

「レイアウトも格納されているデータの順番も同じ2つのシートから、内容の違っているセルを探したい!」

ってことありませんか。

「説明は要(い)らないから、すぐに実行したい!」方は、3.すぐに実行したいにスキップ下さい。

行数が1万行とか、あまりにも多い場合に人間の目で比較して探すのは、時間が掛かり見落としもあったりとたいへんな作業です。

2つのシートから3つ目のシートに異なるセルをピックアップするプログラムを作成しました。

プログラムであれば、早くて正確にピックアップできます。

尚この記事は、Excel-VBAを起動して貼り付ければ動作することを目指しています。

Excel-VBAの構造、起動方法、実行方法などを理解されていない方は、以下の記事を参照しながら一度やってみてから対応されることをお勧めします。

Excel-VBA 実例 この通りやれば動く、とにかく触ってみよう
こんにちは! 健史(たけふみ)です。 パソコンをお使いの方の多くは、表計算ソフトExcelを利用されていると思います。 この記事は、Exceは知っているけれど ・Excel-VBAって何? ・Excel-VBAは取っ付きにく...

実行中に発生したエラーの対処法は、上記記事の2.エラーが発生したときの対処法に記載しています。(この段落のリンクから直接遷移します)

スポンサーリンク

プログラムの作成と実行

今回のサンプルプログラムは

シート1とシート2の内容を比較して、異なる内容をシート3に出力する

です。

プログラムの概要は以下の通りです。
・同じフォーマットで一部の値が異なる2つのシートがあり、シート3に「値が異なるセルの内容」を出力する
・基のシートの異なる部分には、マーキングする

データ量が多い場合、目視で探すのは不可能に近く、見間違えもあり非効率です。

そんな時に対応するプログラムです。

ファイルの更新系プログラム(追加・削除を伴わない)のテスト確認で、更新前後のファイルを比較するときなどにも使えます。

実行までの手順

1.Excelを起動

2.データ入力
Excel2007以降は、Sheet1のみであるためシートを2つ追加し、全部で3つ作成しておきます。

Book1のSheet1とSheet2のセル[A1]~[E5]に、分かりやすいようにセルの番号を入力します。

そして、Sheet1とSheet2の何ヵ所かの値を変えます。

3.Excel-VBAを起動
Altを押した状態でF8キーを押します。

4.[マクロ名(M):]に'test'と入力(''は不要、''内のtestを入力)

5.[作成(C)]をクリック
私はマクロ名を入力したら、そのままEnterを押します。

6.以下のプログラムをドラッグ&コピー

    Dim i, j, i3 As Long
    
    Worksheets(1).Cells.ClearFormats
    Worksheets(2).Cells.ClearFormats
    Worksheets(3).Cells.Clear
   
    Worksheets(3).Cells(1, 1) = "セル"
    Worksheets(3).Cells(1, 2) = "シート1"
    Worksheets(3).Cells(1, 3) = "シート2"
 
    i3 = 1
    For i = 1 To 5
        For j = 1 To 5
            If Worksheets(1).Cells(i, j) <> Worksheets(2).Cells(i, j) Then
                i3 = i3 + 1
                Worksheets(3).Cells(i3, 1) = Worksheets(1).Cells(i, j).Address
                Worksheets(3).Cells(i3, 1) = Replace(Worksheets(3).Cells(i3, 1), "$", "")
                Worksheets(3).Cells(i3, 2) = Worksheets(1).Cells(i, j)
                Worksheets(3).Cells(i3, 3) = Worksheets(2).Cells(i, j)
                Worksheets(1).Cells(i, j).Interior.Color = vbRed
                Worksheets(2).Cells(i, j).Interior.Color = vbYellow
            End If
        Next
    Next

6.以下に貼り付け(ペースト)

Sub test()
ここに貼り付ける
End Sub

7.F5キーで実行

8.実行結果の確認
Book1に切り替えて下さい。
Altを押した状態でTabキーを押して、Book1に位置づいたらTabキーを離すことで切り替わります。

シート1、シート2でマーキングされているセルが異なる部分です。

シート3には、異なる内容が出力されています。

フローチャート

ループ処理である[For i = 1 To 5 ・・・ Next]部分フローチャートです。

iで固定した状態でjを1~5まで変えながら処理を行います。

具体的には、
①.i=1に固定した状態で、jを1~5まで変えながら処理を行う
②.i=2に固定した状態で、jを1~5まで変えながら処理を行う
③.i=3に固定した状態で、jを1~5まで変えながら処理を行う
④.i=4に固定した状態で、jを1~5まで変えながら処理を行う
⑤.i=5に固定した状態で、jを1~5まで変えながら処理を行う
です。

プログラムの詳細説明

    Dim i As Long, j As Long, i3 As Long	
        i,j,i3 という名前のデータをプログラム内に定義
    Worksheets(1).Cells.ClearFormats	
        Worksheets(1)であるSheet1の書式設定だけをクリアする
        最初は何も設定されていないのですが、複数回流す場合などを考慮してクリアします
    Worksheets(2).Cells.ClearFormats	
        Worksheets(2)であるSheet2の書式設定だけをクリアする
    Worksheets(3).Cells.Clear	
        Worksheets(3)であるSheet3の内容、書式設定などすべてをクリアする
   	
    Worksheets(3).Cells(1, 1) = "セル"	
    Worksheets(3).Cells(1, 2) = "シート1"		
    Worksheets(3).Cells(1, 3) = "シート2"		
        Worksheets(3)であるSheet3に見出しを付ける	
 		
    i3 = 1		
        Sheet3に内容を出力するが、1番目には見出しが入っていて2番目から出力するので1をセットして
        おく、i3は「何番目までデータが入っている」ということを示す	
        最初に2をセットしておいて、セットしたら1カウントアップする方法もある	
    For i = 1 To 5		
        iに1をセットし1づつカウントアップして[i > 5]になるまで一番下のNextの範囲までの
        処理を繰り返す	
        For j = 1 To 5		
            jに1をセットし1づつカウントアップして[j > 5]になるまで下から2番目のNextの
            範囲までの処理を繰り返す
            If Worksheets(1).Cells(i, j) <> Worksheets(2).Cells(i, j) Then		
               「Sheet1とSheet2の同じi行目、j列目を比較して、等しくない時は」という意味
                 等しい場合には、<>を=に変える
                i3 = i3 + 1			
                    対象データがあったので、Sheet3に内容を出力するためi3を1カウントアップする
                Worksheets(3).Cells(i3, 1) = Worksheets(1).Cells(i, j).Address			
                    [Address]はセル番号を出力する指定であるが、[A1]の場合には[$A$1]と出力される
                Worksheets(3).Cells(i3, 1) = Replace(Worksheets(3).Cells(i3, 1), "$", "")			
                    [$A$1]と出力されてしまうので、Replace命令で"$"を空白に置き換える
                Worksheets(3).Cells(i3, 2) = Worksheets(1).Cells(i, j)
                    Sheet1の内容をSheet3に出力する
                Worksheets(3).Cells(i3, 3) = Worksheets(2).Cells(i, j)
                    Sheet2の内容をSheet3に出力する
                Worksheets(1).Cells(i, j).Interior.Color = vbRed
                    Sheet1のセルの色を変更する、レッド
                Worksheets(2).Cells(i, j).Interior.Color = vbYelow
                    Sheet1のセルの色を変更する、イエロー
            End If			
        Next			
    Next

補足です。

・変数について
今回は、3つの変数[i,j,i3]を使います。

i3は[i:縦の行を示し]+[3:3番目のシートで使うもの]なので、'i3'としました。

・Cells.ClearFormats、Cells.Clear について
都度、シートを別ファイルから持ってきたり、sheet3は手でクリアしたり、削除して再度作成するなどの対応であれば不要です。

・[i3 = 1]と[i3 = i + 1]について
[i3 = 1]を[i3 = 2]にした場合、[i3 = i + 1]の位置は[Worksheets(3).Cells(i3, 3) = Worksheets(2).Cells(i, j)]の後にする必要があります。

この場合のi3は「次に入る行の番号」を示しています。

好みの問題ですが、私はその変数が「今何番目まで入っている」という処理、すなわち[i3 = 1]にしておいてセットする直前で[i3 = i + 1]を行う処理としています。

・.Address について
セル番号を出力する方法は他にもありまが、[.Address]がスッキリしているので採用しました。

ですが、[$A$1]のように'$'が付いてきます。そのため次の命令[Replace]で、'$'を無くす処理を入れました。

・Interior.Color について
ネットにて'vbcolor'で検索できます。

・比較する範囲を自動で設定する

上記プログラムでは、行と列の数を「5」と固定した値で作成しました。

Sheet1のセル[A1]にカーソルがある状態で[Crtl]&[End]キー押して、データが格納されている最後の行列を取得し使用する場合には以下のようにします。

'追加
    Dim i_last ,j_last As Long 

'追加
    i_last = Range("A1").SpecialCells(xlLastCell).Row
    j_last = Range("A1").SpecialCells(xlLastCell).Column

'修正
    For i = 1 To i_last
        For j = 1 To j_last
       

最後に

このプログラムは、シート1とシート2について、セル[A1][A2][A3][A4][A5][B1][B2]・・・[C3][C4][C5]と一つひとつ比較し、異なる部分をシート3に出力するプログラムでした。

最初のシートフォーマットやシートをクリアする処理、セルにマーキングする処理が不要だったり、逆にシート3に出力する処理が不要だったり、ケースは多々あると思います。

使うシーンに応じて対応して頂ければと思います。

すぐに実行したい

行数と列数が同じシートを比較

以下の条件でデータが揃っていれば、VBAを起動し貼り付け実行できます。

・Sheet1とSheet2に行列数とも同じ比較対象データを格納
・Sheet3を空白で作成

処理の最初に確認のため、比較対象の行数と列数をメッセージ表示していますが、[OK]ボタンをクリックします。

'変数定義
    Dim i, j, i3 As Long
    Dim i_last, j_last As Long
'初期クリア    
    Worksheets(1).Cells.ClearFormats
    Worksheets(2).Cells.ClearFormats
    Worksheets(3).Cells.Clear
'シート3の見出し設定   
    Worksheets(3).Cells(1, 1) = "セル"
    Worksheets(3).Cells(1, 2) = "シート1"
    Worksheets(3).Cells(1, 3) = "シート2"
'セル[A1]で Ctrl+Endを押したときの最終行と最終列を取得 
    i_last = Range("A1").SpecialCells(xlLastCell).Row
    j_last = Range("A1").SpecialCells(xlLastCell).Column
'確認のため比較対象の行数と列数をメッセージ表示
    MsgBox "最終行は " & i_last & "、最終列は " & j_last
'Sheet3の添え字初期値設定    
    i3 = 1
'比較処理
    For i = 1 To i_last
        For j = 1 To j_last
            If Worksheets(1).Cells(i, j) <> Worksheets(2).Cells(i, j) Then
                i3 = i3 + 1
                Worksheets(3).Cells(i3, 1) = Worksheets(1).Cells(i, j).Address
                Worksheets(3).Cells(i3, 1) = Replace(Worksheets(3).Cells(i3, 1), "$", "")
                Worksheets(3).Cells(i3, 2) = Worksheets(1).Cells(i, j)
                Worksheets(3).Cells(i3, 3) = Worksheets(2).Cells(i, j)
                Worksheets(1).Cells(i, j).Interior.Color = vbRed
                Worksheets(2).Cells(i, j).Interior.Color = vbYellow
            End If
        Next
    Next

行数と列数が異なるシートを比較

冒頭で「ファイルの更新系プログラム(追加・削除を伴わない)のテスト確認で、更新前後のファイルを比較する」プログラムと記載しました。

ここで紹介するのは、データの更新に加え、データの末尾の後ろにデータが追加された場合に対応するプログラムです。

追加した機能は、「更新前シートと更新後シートの最終行を取得する処理で、大きい方の値を比較値にする」です。

同様に、列データも最終列の大きい値を比較するようにしました。

    Dim i, j, i3 As Long
    Dim i_last, j_last As Long
    
    Sheets(1).Cells.ClearFormats
    Sheets(2).Cells.ClearFormats
    Sheets(3).Cells.Clear
   
    Sheets(3).Cells(1, 1) = "セル"
    Sheets(3).Cells(1, 2) = "シート1"
    Sheets(3).Cells(1, 3) = "シート2"
    Sheets(3).Cells(1, 4) = "最大行"
    Sheets(3).Cells(1, 5) = "最大列"
'大きい行数を求める
    If Sheets(1).Range("A1").SpecialCells(xlLastCell).Row > _
       Sheets(2).Range("A1").SpecialCells(xlLastCell).Row Then
        i_last = Sheets(1).Range("A1").SpecialCells(xlLastCell).Row
    Else
        i_last = Sheets(2).Range("A1").SpecialCells(xlLastCell).Row
    End If
    Sheets(3).Cells(2, 4) = i_last
'大きい列数を求める
    If Sheets(1).Range("A1").SpecialCells(xlLastCell).Column > _
       Sheets(2).Range("A1").SpecialCells(xlLastCell).Column Then
        j_last = Sheets(1).Range("A1").SpecialCells(xlLastCell).Column
    Else
        j_last = Sheets(2).Range("A1").SpecialCells(xlLastCell).Column
    End If
    Sheets(3).Cells(2, 5) = j_last
 
    i3 = 1
    For i = 1 To i_last
        For j = 1 To j_last
            If Sheets(1).Cells(i, j) <> Sheets(2).Cells(i, j) Then
                i3 = i3 + 1
                Sheets(3).Cells(i3, 1) = Sheets(1).Cells(i, j).Address
                Sheets(3).Cells(i3, 1) = Replace(Sheets(3).Cells(i3, 1), "$", "")
                Sheets(3).Cells(i3, 2) = Sheets(1).Cells(i, j)
                Sheets(3).Cells(i3, 3) = Sheets(2).Cells(i, j)
                Sheets(1).Cells(i, j).Interior.Color = vbRed
                Sheets(2).Cells(i, j).Interior.Color = vbYellow
            End If
        Next
    Next
    
    MsgBox "処理終了"

データの途中、例えば100件あって50-51行目に追加された場合は、51行目以降がすべて異なるデータとして処理されます。

追加された行数が分かるのであれば実行前に、手で更新前データの50-51行目に1行空白データ追加して実行することで、該当行が異なるデータとして処理されます。

ただし追加されたデータ多い場合には、手で追加するのは非効率です。

そのような場合には、データの並び順は入れ替わってしまいますが、重複がないユニークキー項目を特定し、ソートしてから実行します。

もとの並び順に戻したいのであれば、1列追加し1~の連番を振っておき、実行後に連番でソートし直すことで並び順は戻ります。

その他、
・Worksheets→Sheetsに修正
・処理する最大行と最大列の値をシート3のD列、E列に追加
・処理終了のメッセージを表示
しました。

EXCEL VBA
スポンサーリンク
- 面白かったらシェアお願いします! -
健史をフォローする
自分で改善

コメント