Excel VBA 別シートの表を比較、２列で一意、差異の抽出

Question

前提

Excel VBA初心者です。
業務の一環で、マクロを用いて帳票作成を行うのですが、
検索をしてもなかなかヒットせず、
どなたかお力添えを頂ければと思い質問致します。

・１シートに表が１つずつあり、２シートの表を比較
・２つの表の列数は変わらず行数は可変
・A列とD列（商品コードと納品先）で一意となる

・昨日シートと本日シートを比較して差異区分を新規シート（sheet3)にまとめたい。
※差異区分
1.新規（本日シートにあって昨日シートにない）
2.変更（金額１）
3.変更（金額２）
4.削除(昨日にあって本日にない）

・例
sheet1「昨日シート」
商品コード/商品名/産地/納品先/金額１/金額２
A100/ りんご/青森/ 東京　/100/150
A101/青リンゴ/青森/神奈川/120/170
B150/みかん/愛媛/東京/300/500
・
・
・

sheet2「本日シート」
商品コード/商品名/産地/納品先/金額１/金額２
A100/ りんご/青森/ 東京　/100/150
A101/青リンゴ/青森/神奈川/120/200
C200/マンゴー/宮崎/東京/300/500
・
・
・

###　目標の作成物
新規のシートに差異一覧を表示させる。

A列に差異区分、B列以降は本日シートと同じ項目の転記

差異区分/商品コード/商品名/産地/納品先/金額１/金額２

上記の例で言うと、

差異区分/商品コード/商品名/産地/納品先/金額１/金額２
2.変更（金額２）/A101/青リンゴ/青森/神奈川/120/200
4.削除/B150/みかん/愛媛/東京/300/500
1.新規/C200/マンゴー/宮崎/東京/300/500

こんな感じで表示させたいです。

同一の表での重複検索や重複削除のページは見つかるのですが
２列で一意になる表で表が２つ、というものが見つかりませんでした。

※タブ区切りのテキストファイルが表の元データになるのですが
タブ区切りのテキストファイルをExcelのワークシートに出力するマクロを組んでいます。
いずれはテキストファイルを出力せずに比較→差分のみ抽出、としたいのですが・・・。

参考になるページだけでも構いません。
不慣れで長文になってしまい申し訳ございませんが、
何卒宜しくお願い致します。

Comments

[meg_]

VBAでの手順は頭に浮かんでいますか？全く浮かばないのであれば、VBAではなくVlookup関数とフィルタを使用した手作業の方が良いかもしれません。（関数使えばそれほど時間もかからないでしょう）

[a8_07]

記載有難うございます。
ご指摘いただいた通り知識がほぼ無いことも相まって正直手順は浮かんでいないのが事実ではありますが、
VBAでの作成指示があったので質問致しました。
頂いた回答を元に勉強しながら作成できればと思っています。

Answer 1

こんにちはこんばんは、よろしくおねがいいたします。
ちょっと自分なりに作ってみました。なかなか本格的なプログラムになってしまいましたが・・
”本日シートを検索元として昨日シートを検索する”のと”昨日シートを検索元として本日シートを検索する”の２部構成に、どうしてもなってしまいますね。

以下のプログラムで、私のほうで動作確認しました。
よかったらご参考になさってください。

Option Explicit

Sub ExamineCompareTwoSheets()
'昨日シートと本日シートを比較検証して結果を出力するVBAです
'２部構成になっています

'パートAは、本日シートのA列（商品コード）を、上から最後までいっこずつ順に降りていき、
'商品コードによって昨日シートのA列をサーチし、その結果によって以下の判定を行います
'1.新規＝本日シートにあって昨日シートにない
'2.変更（金額１）＝金額１に差異がある
'3.変更（金額２）＝金額２に差異がある
'4.削除＝昨日にあって本日にない

'パートBは、昨日シートのA列（商品コード）を、上から最後までいっこずつ順に降りていき、
'商品コードによって本日シートのA列をサーチし、その結果によって以下の判定を行います
'4.削除＝昨日にあって本日にない

'シートの定義です
  Dim YesterdaySheet As Worksheet
  Dim TodaySheet As Worksheet
  Dim ReportSheet As Worksheet
  
  Set YesterdaySheet = ThisWorkbook.Worksheets("昨日シート")
  Set TodaySheet = ThisWorkbook.Worksheets("本日シート")
  Set ReportSheet = ThisWorkbook.Worksheets("差異シート")

'出力先の差異シートの行番号です
  Dim ReportRow As Long
  ReportRow = 2 '２行目からスタートするとします

'差異区分（A列）にセットする文字を定義しておきます
  Dim SaiFlag1 As String
  Dim SaiFlag2 As String
  Dim SaiFlag3 As String
  Dim SaiFlag4 As String
  
  SaiFlag1 = "1.新規"
  SaiFlag2 = "2.変更（金額１）"
  SaiFlag3 = "3.変更（金額２）"
  SaiFlag4 = "4.削除"

'当日シート昨日シートの各列のデータセットを定義しておきます
    Dim TodayShohinCode As String '当日シートの商品コード
    Dim TodayShohinMei As String  '当日シートの商品名
    Dim TodaySanchi As String '当日シートの産地
    Dim TodayNohinsaki As String  '当日シートの納品先
    Dim TodayKingaku1 As Long   '当日シートの金額１
    Dim TodayKingaku2 As Long   '当日シートの金額２

    Dim YesterdayShohinCode As String '昨日シートの商品コード
    Dim YesterdayShohinMei As String '昨日シートの商品名
    Dim YesterdaySanchi As String '昨日シートの産地
    Dim YesterdayNohinsaki As String '昨日シートの納品先
    Dim YesterdayKingaku1 As Long  '昨日シートの金額１
    Dim YesterdayKingaku2 As Long '昨日シートの金額２


Dim r As Range  'foreachするためのレンジの定義です

'昨日シートの商品コード列を定義しておきます
YesterdaySheet.Select
  Dim YesterdaySearchRange As Range
  Set YesterdaySearchRange = YesterdaySheet.Range("A2", Range("A2").End(xlDown))

'本日シートの商品コード列を定義しておきます
TodaySheet.Select
  Dim TodaySearchRange As Range
  Set TodaySearchRange = TodaySheet.Range("A2", Range("A1").End(xlDown))

'昨日シートをFINDした結果を格納するレンジです
Dim YesterdayFoundRange As Range
'本日シートをFINDした結果を格納するレンジです
Dim TodayFoundRange As Range

'＊＊＊パートA：本日シートの商品コードを上から下までナメていきます
For Each r In TodaySheet.Range("A2", Range("A1").End(xlDown))
        'この行の各カラムの情報を格納しておきます
        TodayShohinCode = r.Value
        TodayShohinMei = r.Offset(0, 1).Value
        TodaySanchi = r.Offset(0, 2).Value
        TodayNohinsaki = r.Offset(0, 3).Value
        TodayKingaku1 = r.Offset(0, 4).Value
        TodayKingaku2 = r.Offset(0, 5).Value

  '本日シートの商品コードで、昨日シートの商品コード列をサーチします
  Set YesterdayFoundRange = YesterdaySearchRange.Find(what:=TodayShohinCode, lookat:=xlWhole)

  If YesterdayFoundRange Is Nothing Then
  '該当する商品コードがなかったとき(=本日にあって昨日にない）＝「新規」
        '本日シートのレコード一式を差異シートに出力する
        With ReportSheet
            Debug.Print "「新規」..."
            .Cells(ReportRow, 1) = SaiFlag1  '差異区分
            .Cells(ReportRow, 2) = TodayShohinMei  '商品コード
            .Cells(ReportRow, 3) = r.Value  '商品名
            .Cells(ReportRow, 4) = TodaySanchi  '産地
            .Cells(ReportRow, 5) = TodayNohinsaki  '納品先
            .Cells(ReportRow, 6) = TodayKingaku1  '金額１
            .Cells(ReportRow, 7) = TodayKingaku2  '金額２
        End With

        ReportRow = ReportRow + 1 '差異レポートシートを、１行送りしておきます
  
  Else
  '該当する商品コードがあったとき
    '昨日シートのこの行の各カラムの情報を格納しておきます
    With YesterdayFoundRange
      YesterdayShohinCode = .Value '昨日シートの商品コード
      YesterdayShohinMei = .Offset(0, 1).Value '昨日シートの商品名
      YesterdaySanchi = .Offset(0, 2).Value '昨日シートの産地
      YesterdayNohinsaki = .Offset(0, 3).Value ' '昨日シートの納品先
      YesterdayKingaku1 = .Offset(0, 4).Value '  '昨日シートの金額１
      YesterdayKingaku2 = .Offset(0, 5).Value ' '昨日シートの金額２
    End With

    If TodayKingaku1 <> YesterdayKingaku1 Then
      '金額１に差異があったとき
        '本日シートのレコード一式を差異シートに出力する
            With ReportSheet
                .Cells(ReportRow, 1) = SaiFlag2  '差異区分
                .Cells(ReportRow, 2) = r.Value  '商品コード
                .Cells(ReportRow, 3) = TodayShohinMei  '商品名
                .Cells(ReportRow, 4) = TodaySanchi  '産地
                .Cells(ReportRow, 5) = TodayNohinsaki  '納品先
                .Cells(ReportRow, 6) = TodayKingaku1  '金額１
                .Cells(ReportRow, 7) = TodayKingaku2  '金額２
            End With
          ReportRow = ReportRow + 1 '差異レポートシートを、１行送りしておきます
      End If

    '金額２に差異があったとき
    If TodayKingaku2 <> YesterdayKingaku2 Then
        '本日シートのレコード一式を差異シートに出力する
            With ReportSheet
                .Cells(ReportRow, 1) = SaiFlag3  '差異区分
                .Cells(ReportRow, 2) = r.Value  '商品コード
                .Cells(ReportRow, 3) = TodayShohinMei  '商品名
                .Cells(ReportRow, 4) = TodaySanchi  '産地
                .Cells(ReportRow, 5) = TodayNohinsaki  '納品先
                .Cells(ReportRow, 6) = TodayKingaku1  '金額１
                .Cells(ReportRow, 7) = TodayKingaku2  '金額２
            End With
            ReportRow = ReportRow + 1 '差異レポートシートを、１行送りしておきます
    End If
  End If

Next r

'＊＊＊パートB：'昨日シートの商品コードを上から下までナメていきます
YesterdaySheet.Select
For Each r In YesterdaySheet.Range("A2", Range("A2").End(xlDown))
        'この行の各カラムの情報を格納しておきます
        YesterdayShohinCode = r.Value
        YesterdayShohinMei = r.Offset(0, 1).Value
        YesterdaySanchi = r.Offset(0, 2).Value
        YesterdayNohinsaki = r.Offset(0, 3).Value
        YesterdayKingaku1 = r.Offset(0, 4).Value
        YesterdayKingaku2 = r.Offset(0, 5).Value

  '昨日シートの商品コードで、本日シートの商品コード列をサーチします
  Set TodayFoundRange = TodaySearchRange.Find(what:=YesterdayShohinCode, lookat:=xlWhole)

  '該当する商品コードがなかったとき(=昨日にあって本日にない）＝「削除」
  If TodayFoundRange Is Nothing Then
            With ReportSheet
                .Cells(ReportRow, 1) = SaiFlag4  '差異区分
                .Cells(ReportRow, 2) = YesterdayShohinCode  '商品コード
                .Cells(ReportRow, 3) = YesterdayShohinMei  '商品名
                .Cells(ReportRow, 4) = YesterdaySanchi  '産地
                .Cells(ReportRow, 5) = YesterdayNohinsaki  '納品先
                .Cells(ReportRow, 6) = YesterdayKingaku1  '金額１
                .Cells(ReportRow, 7) = YesterdayKingaku2  '金額２
            End With
            ReportRow = ReportRow + 1 '差異レポートシートを、１行送りしておきます
    End If

Next r

End Sub

Comments

[a8_07]

AkiSaito様、回答有難うございます！
コメントも詳細に記載いただきとても助かります。
木曜以降に時間が取れそうなので、こちらのコードを元にいじってみようと思います。

２部構成になるとのこと、お時間をかけて頂きとても恐縮です。
誠に有難うございます！

Answer 2

こんばんは。コードが長くなるため、金額1、金額2の変更があった場合の例）のみ

提示させていただきます（あえて泥臭いコードとなっています）。

コードが新規の場合、コードが削除された場合は検証してみてください。

昨日シート
本日シート
管理シート
があります。昨日シートと本日シートで商品コードが同じで金額1,金額2が変わった場合
管理シートに記載していくというコードになります。
管理シートの１行目にはタイトルが入力されています。
A１　　　B1　　　　　C1　　　D1　　E1　　　　F1　　　G1
差異区分 商品コード　商品名　産地 納品先 金額1 金額2

これをベースに考えるきっかけとなればいいのですが・・。

Sub test()
Dim data1 As Long
Dim data2 As Long
'※他の変数の宣言は省略（定義してください）

data1 = Sheets("昨日").Range("A1").CurrentRegion.Rows.Count '最終行を数える
data2 = Sheets("本日").Range("A1").CurrentRegion.Rows.Count'最終行を数える

転記 = 1

For cnt1 = 2 To data1

            With Sheets("昨日")
                昨日_商品コード = .Range("A" & cnt1).Value
                昨日_商品名 = .Range("B" & cnt1).Value
                昨日_産地 = .Range("C" & cnt1).Value
                昨日_納品先 = .Range("D" & cnt1).Value
                昨日_金額1 = .Range("E" & cnt1).Value
                昨日_金額2 = .Range("F" & cnt1).Value
            
            End With
            
                

    For cnt2 = 2 To data2
    
              With Sheets("本日")
                本日_商品コード = .Range("A" & cnt2).Value
                本日_商品名 = .Range("B" & cnt2).Value
                本日_産地 = .Range("C" & cnt2).Value
                本日_納品先 = .Range("D" & cnt2).Value
                本日_金額1 = .Range("E" & cnt2).Value
                本日_金額2 = .Range("F" & cnt2).Value
            
            End With
            
            
            '■金額1の変更があった場合
                If 昨日_商品コード = 本日_商品コード Then
                    
                        If 昨日_金額1 <> 本日_金額1 Then
        
                            転記 = 転記 + 1
                               
                                With Sheets("管理")
                                    .Range("A" & 転記).Value = "2.変更(金額1)"
                                    .Range("B" & 転記).Value = 本日_商品コード
                                    .Range("C" & 転記).Value = 本日_商品名
                                    .Range("D" & 転記).Value = 本日_産地
                                    .Range("E" & 転記).Value = 本日_納品先
                                    .Range("F" & 転記).Value = 本日_金額1
                                    .Range("G" & 転記).Value = 本日_金額2
                                End With
                            
                       End If
                 End If

            '■金額2の変更があった場合
            
                If 昨日_商品コード = 本日_商品コード Then
                    
                        If 昨日_金額2 <> 本日_金額2 Then
                        
        
                            転記 = 転記 + 1
                               
                                With Sheets("管理")
                                    .Range("A" & 転記).Value = "2.変更(金額2)"
                                    .Range("B" & 転記).Value = 本日_商品コード
                                    .Range("C" & 転記).Value = 本日_商品名
                                    .Range("D" & 転記).Value = 本日_産地
                                    .Range("E" & 転記).Value = 本日_納品先
                                    .Range("F" & 転記).Value = 本日_金額1
                                    .Range("G" & 転記).Value = 本日_金額2
                                End With
                            
                       End If
                 End If

    Next
    
Next

End Sub

Comments

[退会済みユーザー]

追加のロジックです。例えば・・・・。

新規・削除を判定する（例）ですがExcel関数を組み合わせることでVBAのコードを簡略化できます。

一例）を示します。
例1)本日シートに昨日シートのコード（A列）があるか（削除）を判定する場合：エクセル関数ですと。。
=COUNTIF(昨日!A:A,"B150") 'みかんで0件となります（もちろんこの場合セル番号を指定します）。。。。

これをVBAに置き換えると
件数＝worksheetfunction.COUNTIF(昨日!A:A,"B150") で、0件となります。
これをVBAらしくセルを指定する形式に置き換えると。。

for cnt = 2 to XX

件数＝worksheetfunction.COUNTIF(sheets("昨日").range("A:A"),sheets("本日").range("A" & cnt).value)

next

となります。。。。このコードを基本とすれば、いったんVBAですべての行をチェックをしなくても
本日シートの値が昨日シートに含まれているか・コードがあるか（削除）されたか判定できます。。。

あくまでも泥臭くなのですが。伝わるとうれしいのですが・・。
理解できるまでは、エクセル関数のcountif関数を呼び出して対象のコードが0件なら
削除された、新規で追加されたという条件判定に利用しましょう。。。。

一見簡単なのですが、少し複雑なためです。

[a8_07]

記載いただき有難うございます。
エクセル関数を呼び出す、と言う方法があるのですね。
お時間かけていただき誠に有難うございます。

木曜日以降時間が取れるので、こちらの回答を参考にしながらコードを作成してみます。
お忙しい中有難うございました！