VBA 2つのエクセルシートのデータ突合について教えて下さい

仕事で効率的になるようにVBAを勉強しながらプログラムを作成しているのですが、
同じエクセルで２つのシートの突合でどうすればいいのか頭を悩ませています。
ご教授頂けると助かります。

◆シートの配列◆
【Sheet1】B4「種類」 G4「番号」 K4「商品コード」 M4「数量」 S4「金額」
　　　　　※5行目からデータが入っていて最終行は毎回違います。　　　
【Sheet2】A2「番号」 C2「商品コード」 E2「分類」 F2「A数量」 G2「B数量」 H2「金額」
　　　　　※3行目からデータが入っていて最終行は毎回違います。
（上記の列以外もデータが入っていますが突合対象のデータではありません）

実行したい内容は、【Sheet1】G列「番号」と【Sheet2】A列「番号」をキーとして一致した行の下記【1】～【4】のデータが一致しているかを確認したいのですが、下記内容【1】【2】がシートでタイトル名とデータの文言が違います。
システムから出力しているデータなので変更ができません。
※同じシート内で重複している「番号」はないです。

【1】一致確認列：【Sheet1】B列「種類」＝【Sheet2】 E列「分類」
　　　 ﾊﾟﾀｰﾝ1【Sheet1】「種類」データが小型or中型＝【Sheet2】「分類」データがBで一致
　　 　ﾊﾟﾀｰﾝ2【Sheet1】「種類」データが大型=【Sheet2】「分類」データがAで一致

【2】一致確認列：【Sheet1】 M列「数量」＝【Sheet2】F列「A数量」or G列「B数量」
　　　上記、ﾊﾟﾀｰﾝ1の場合は【Sheet1】M列「数量」＝【Sheet2】 G列「B数量」
　　　上記、ﾊﾟﾀｰﾝ2の場合は【Sheet1】M列「数量」＝【Sheet2】 F列「A数量」

【3】一致確認列：【Sheet1】K列「商品コード」＝【Sheet2】 C列「商品コード」

【4】一致確認列：【Sheet1】S列「金額」＝【Sheet2】 H列「金額」

全一致で「一致」１箇所でも不一致があれば「不一致」のメッセージBoxを表示させたいです。
そして、一致しない箇所があれば色付けしたいと思っています。

複雑な内容で分かりにくい文書の記載のみとなり大変申し訳ございませんが、
ご教授いただけますよう宜しくお願い致します。

No.2 ベストアンサー 回答者： GooUserラック 回答日時： 2016/08/22 10:43

とりあえず、こんな事でしょうか？

---------------------------------------------------------------------------
Sub Macro1()

Dim 一致 As Boolean
Dim 不一致 As Boolean
Dim 元行 As Long
Dim 元終 As Long
Dim 先行 As Long
Dim 先終 As Long
Dim 色 As Long

色 = RGB(255, 0, 0)
元終 = Sheets("Sheet1").Cells(Rows.Count, 7).End(xlUp).Row
先終 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For 元行 = 5 To 元終
一致 = False
For 先行 = 3 To 先終
If Sheets("Sheet1").Cells(元行, 7).Value = Sheets("Sheet2").Cells(先行, 1).Value Then

Sheets("Sheet1").Cells(元行, 2).Interior.Color = 色
Sheets("Sheet2").Cells(先行, 5).Interior.Color = 色
Select Case Sheets("Sheet1").Cells(元行, 2).Value
Case "小型", "中型"
If Sheets("Sheet2").Cells(先行, 5).Value = "B" Then
Sheets("Sheet1").Cells(元行, 2).Interior.ColorIndex = xlNone
Sheets("Sheet2").Cells(先行, 5).Interior.ColorIndex = xlNone
Else
不一致 = True
End If
Case "大型"
If Sheets("Sheet2").Cells(先行, 5).Value = "A" Then
Sheets("Sheet1").Cells(元行, 2).Interior.ColorIndex = xlNone
Sheets("Sheet2").Cells(先行, 5).Interior.ColorIndex = xlNone
Else
不一致 = True
End If
Case Else
不一致 = True
End Select

Sheets("Sheet1").Cells(元行, 13).Interior.Color = 色
Sheets("Sheet2").Cells(先行, 6).Interior.Color = 色
Sheets("Sheet2").Cells(先行, 7).Interior.Color = 色
If Sheets("Sheet1").Cells(元行, 13).Value = Sheets("Sheet2").Cells(先行, 6).Value Then
Sheets("Sheet1").Cells(元行, 13).Interior.ColorIndex = xlNone
Sheets("Sheet2").Cells(先行, 6).Interior.ColorIndex = xlNone
Sheets("Sheet2").Cells(先行, 7).Interior.ColorIndex = xlNone
Else
If Sheets("Sheet1").Cells(元行, 13).Value = Sheets("Sheet2").Cells(先行, 7).Value Then
Sheets("Sheet1").Cells(元行, 13).Interior.ColorIndex = xlNone
Sheets("Sheet2").Cells(先行, 6).Interior.ColorIndex = xlNone
Sheets("Sheet2").Cells(先行, 7).Interior.ColorIndex = xlNone
Else
不一致 = True
End If
End If

If Sheets("Sheet1").Cells(元行, 11).Value <> Sheets("Sheet2").Cells(先行, 3).Value Then
Sheets("Sheet1").Cells(元行, 11).Interior.Color = 色
Sheets("Sheet2").Cells(先行, 3).Interior.Color = 色
不一致 = True
End If

If Sheets("Sheet1").Cells(元行, 19).Value <> Sheets("Sheet2").Cells(先行, 8).Value Then
Sheets("Sheet1").Cells(元行, 19).Interior.Color = 色
Sheets("Sheet2").Cells(先行, 8).Interior.Color = 色
不一致 = True
End If

一致 = True
Exit For
End If
Next
If 一致 = False Then
Sheets("Sheet1").Cells(元行, 7).Interior.Color = 色
不一致 = True
End If
Next
For 先行 = 3 To 先終
一致 = False
For 元行 = 5 To 元終
If Sheets("Sheet1").Cells(元行, 7).Value = Sheets("Sheet2").Cells(先行, 1).Value Then
一致 = True
Exit For
End If
Next
If 一致 = False Then
Sheets("Sheet2").Cells(先行, 1).Interior.Color = 色
不一致 = True
End If
Next
If 不一致 Then
MsgBox ("不一致")
Else
MsgBox ("一致")
End If

End Sub
---------------------------------------------------------------------------
・ 適当に作りましたので、結構時間がかかります。
・「一致しない箇所があれば色付け」は、とりあえず「赤」にしてます。
　「色 = RGB(255, 0, 0)」を変えればお好みの色に変更出来ます。
・ 両シート共「番号」でソートしてしまってもよければもっと早い処理ができます。

この回答へのお礼

教えていただいたプログラムで思う通りの処理ができました。
ご教授いただきありがとうございました。

お礼日時：2016/08/22 16:50

No.1 回答者： GooUserラック 回答日時： 2016/08/21 23:57

「メッセージBoxを表示」とは１行ずつ全行で表示していくのでしょうか？

それとも全行が全て一致していなければ「不一致」と言うことでしょうか？

この回答へのお礼

お返事ありがとうございます。
1行ずつ全行でメッセージBoxを表示させていくのではなく、
「番号」をキーとして【1】〜【4】の全データが一致の場合に「一致」
1箇所でも一致しない箇所がある場合に「不一致」のメッセージBoxを
全てのデータを突合後に表示させたいです。

お礼日時：2016/08/22 00:24