２つの表を比較して、重複する行を色づけするマクロ

質問

下記の様な日付の名前の2つのシートが有るのですが、表２の機種を参照して、B～T列全てが一致する場合、U列チェック欄に○と入力する様なマクロを作成したいのですが、何か良い方法が有りましたらご教授下さい。
マクロコードは簡単なものや定番のものなら読めますが
自分ではあまり書けません。
どなたかよろしくお願いいたします。

（日付シート１）　　　　　　　　　　　　　　（日付シート２）
　B～T列　　　　　　　U列　　　　　　　　B～T列　　　　　　U列

機種　機番　製造日　チェック 　　　　機種　機番　製造日　チェック　　　
A-1　　00　　0000　　　○　　　　　　A-1　　00　　0000　　○
A-2　　01　　0001　　　○　　　　　　A-2　　01　　0001　　○
A-3　　02　　0002　　　○　　　　　　A-3　　02　　0002　　○
A-4　　03　　0003　　　○　　　　　　A-4　　03　　0003　　○　
A-5　　04　　0004　　　○　　　　　　A-5　　04　　0004　　○
B-1　　00　　0000　　　　　 　　 　　C-1　　00　　0000
B-1　　01　　0001　　　　　 　 　　　C-2　　01　　0001　　
B-3　　02　　0002

回答No.2

Masa2072 · ベストアンサー

以下のサンプルはT列までのデータを作成するのが面倒なため、データが何列あってもチェック列がデータの最右列にあればOKです。

Sub Sample()
　　Dim Sh1, Sh2 As Worksheet
　　Dim S1A, S2A As Range
　　Dim FstMatch As String
　　Dim S1, S2 As String
　　Dim T, U As Integer

　　Set Sh1 = Sheets("Sheet1")
　　Set Sh2 = Sheets("Sheet2")
　　'チェック列を特定（データの最右列）
　　U = Sh1.Range("A1").End(xlToRight).Column()

　　'A列をA2から順番に処理
　　For Each S1A In Sh1.Range("A2", Sh1.Range("A2").End(xlDown))
　　　　Set S2A = Sh2.Range("A:A").Find(S1A.Value, LookIn:=xlValues)　　'Sheet1のA列の値に一致する最初のセル
　　　　If Not S2A Is Nothing Then
　　　　　　FstMatch = S2A.Address　'最初に一致したセルのアドレスを記憶
　　　　　　Do
　　　　　　　　'比較用のバッファをクリア
　　　　　　　　S1 = ""
　　　　　　　　S2 = ""
　　　　　　　　'比較用のバッファにB列からチェック列の前までのセル値を結合して格納
　　　　　　　　For i = 2 To U - 1
　　　　　　　　　　S1 = S1 & S1A.Offset(0, i)
　　　　　　　　　　S2 = S2 & S2A.Offset(0, i)
　　　　　　　　Next
　　　　　　　　'バッファを比較し、結果をチェック列に格納
　　　　　　　　If S1 = S2 Then
　　　　　　　　　　S1A.Offset(0, U - 1) = "○"
　　　　　　　　　　S2A.Offset(0, U - 1) = "○"
　　　　　　　　Else
　　　　　　　　　　S1A.Offset(0, U - 1) = ""
　　　　　　　　　　S2A.Offset(0, U - 1) = ""
　　　　　　　　End If
　　　　　　　　'次にA列の値に一致するセルを検索
　　　　　　　　Set S2A = Sh2.Range("A:A").Find(S1A.Value, LookIn:=xlValues)
　　　　　　　　'一致したセルのアドレスが最初に一致したセルのアドレスと一致したらループを抜ける
　　　　　　　　'（最初のセルと同じなら検索が一周したと言うこと）
　　　　　　　　If S2A.Address = FstMatch Then
　　　　　　　　　　Exit Do
　　　　　　　　End If
　　　　　　Loop
　　　　End If
　　Next

　　'作成したオブジェクト変数の後片付け
　　Set Sh1 = Nothing
　　Set Sh2 = Nothing
　　Set S1A = Nothing
　　Set S2A = Nothing
End Sub

色づけはチェック列の値を使った条件付き書式を設定する。

回答No.5

Masa2072

> 　B　　C　　　D　　E　　　　｜　 　B　　C　　　D　　E
> 0001　空白　空白　空白　　｜　 空白　0001　空白　空白
> などの場合も重複と見てしまいます。

　　　　　　　　　　S1 = S1 & S1A.Offset(0, i)
　　　　　　　　　　S2 = S2 & S2A.Offset(0, i)
この行を
　　　　　　　　　　S1 = S1 & Iif(IsEmpty(S1A.Offset(0, i)), " ", S1A.Offset(0, i))
　　　　　　　　　　S2 = S2 & Iif(IsEmpty(S2A.Offset(0, i)), " ", S2A.Offset(0, i))
としてセルが空白なら別の文字（今回はスペース1文字）を入れるということにしてはどうでしょうか？

お礼

できました。
ありがとうございます！！

回答No.4

Masa2072

n-junさん、ご訂正ありがとうございます。
どうも頭が半分死んでいるようです（笑）

ご指摘の通り、変数宣言は
Dim Sh1 as Worksheet
Dim Sh2 as Worksheet
Dim S1A as Range
Dim S2A as Range
Dim S1 As String
Dim S2 As String
Dim i as Integer
Dim U as Integer
となります（Tは投稿前に消してしまったので必要ありません。）

補足

Masa2072さま、ありがとうございます。

B～T列まで全て数字が入っているのですが
たとえば、
（表1）　　　　　　　　　 　｜　 　（表2）
　B　　C　　　D　　E　　　　｜　 　B　　C　　　D　　E
0001　空白　空白　空白　　｜　 空白　0001　空白　空白
などの場合も重複と見てしまいます。
回避方法はありますでしょうか？

回答No.3

n-jun

Masa2072さんへ
>Dim Sh1, Sh2 As Worksheet
>Dim S1A, S2A As Range
>Dim FstMatch As String
>Dim S1, S2 As String
>Dim T, U As Integer
変数の宣言の仕方あってますか？
例えば、
>Dim Sh1, Sh2 As Worksheet
Sh2　は　As Worksheetですが、
Sh1　は　Valiantになってしまうと思うのですが。
私の勘違いでしょうか。。。

あと変数iの宣言が抜けてました。

横から失礼しました。

お礼

ありがとうございました。

回答No.1

n-jun

>２つの表を比較して、重複する行を色づけするマクロ
>B～T列全てが一致する場合、U列チェック欄に○と入力する
どちらなのでしょうか？

Dictionary　とかで検索すると類似したものが見つかるかもですよ。