マクロを使用しての重複チェックについて

質問

ここの質問にCOUNTIFや条件式書式などでデータの重複チェックを
する内容はあるのですが、ちょっと思ってるのと違うので
質問します。

A列 B列
1 aaa
1 aaa
2 aaa
2 aaa
3 bbb
3 bbb
4 ccc
4 ccc

上記のように8行のデータがあります。
条件で、A列の数字が同じ数字でB列が同名の場合は、
チェック対象外で、A列の数字が違う数字でB列が同名の場合
（上記でいうと1 aaa と 2 aaaの場合）は、重複で対象行を
網掛けをするという処理を作りたいのですが、そういうことって
できるのでしょうか。
まずは、値を明示的にやるべきだと思いますが、
理想としては、A1とA2が同じ値でB1とB2の値が一緒の値だったら
処理なし。
A1とA2の値が違う値でB1とB2の値が一緒の値だったら
重複っていうような処理を行えたら幸いです。
理由は、どんどんなデータ（行）を追加することを想定させた場合を
考えております。

参考になるのがありましたら教えてください。

回答No.4

KenKen_SP · ベストアンサー

こんにちは。

小手先に走ったコードかもしれませんが。空セル対策や最終行判定などは
省略してます。ソートは多分不要です。

Sub Sample()

　　Dim colGroup As Collection
　　Dim i　　　　As Long
　　Dim sKey　　 As String
　　Dim r　　　　As Range

　　Set colGroup = New Collection
　　On Error Resume Next
　　For i = 1 To 10　　　　　　　　'<--- とりあえず1～10行目まで
　　　　sKey = Cells(i, "B").Value
　　　　colGroup.Add Cells(i, "A"), sKey
　　　　If Err Then
　　　　　　Set r = colGroup(sKey)
　　　　　　colGroup.Remove sKey
　　　　　　colGroup.Add Union(r, Cells(i, "A")), sKey
　　　　　　Err.Clear
　　　　End If
　　Next
　　On Error GoTo 0

　　Set r = Nothing
　　For Each r In colGroup
　　　　If Application.Sum(r) / r.Count <> r.Cells(1).Value Then
　　　　　　r.EntireRow.Interior.ColorIndex = 6
　　　　End If
　　Next

　　Set colGroup = Nothing

End Sub

お礼

回答ありがとうございます。
実際動かしてみまして、ちゃんと動きました。
上記に対して、多少追記したりしましたら、理想の動きが
できました。
ありがとうございました。

回答No.5

zap35

#01です
>失礼かもしれませんが、上記内容は動作確認なさったものですか？？
もちろん動作を確認しております(^^; WinXP＋Office2003です。

数式はＡ１セルに条件付き書式を設定することを前提にしています。もしそれ以外のセルに設定したのであれば動作しないでしょう。
またセルの絶対参照の$を消してしまったら動きませんよ。

>数式が多分間違ってるような気がします。
ご自身がうまくいかなかったからといって、間違っているとは限りませんよ。式の意味が理解できていれば簡単です。

マクロがよろしいようですので、これ以上の追加回答はやめておきます。

回答No.3

imogasi

バッチ処理向きですが、ロジックが簡単になるものとして、
「ソート」法を薦めます。
B列＋A列でソートする。
全行について、B列について直前レコード（行）の内容と比較して行って、B列が直前行と同じで、A列が違う行が出現すると、それ（またはそれに続く同じ行）が質問で検出したい行です。

補足

回答ありがとうございます。
色々試しておりますが、正直うまくいってません．．
ソート法も考えてみます。

回答No.2

NYAx2

次のようにＣ列にチェック欄を設けて作成すれば・・・
LastRow = Range("A655356").End(xlUp).Row 最終行検索
for r0 = 1 to (LastRow - 1)
if Cells(r0, 3) = xlNull then　　　　　チェック済か？
wkA = Cells(r0, 1).Value
wkB = Cells(r0, 2).Value
for r1 = r0 to LastRow
if cells(r1, 3) = xlnull then　チェック済か？
if wkA = Cells(r1, 1).Value And _
wkB = Cells(r1, 2).Value then
cells(r1, 3) = "1"　　　　チェック済
（ここで網掛け指定）
end if
end if
Next r1
End if
Next r0

補足

回答ありがとうございます。
試しに動かしてみましたが、全て網掛けしてしまうのでは
ないかと思います。
気になったことをコメントで質問させてください。
LastRow = Range("A65356").End(xlUp).Row

For r0 = 1 To (LastRow - 1)
If Cells(r0, 3) = xlNull Then
wkA = Cells(r0, 1).Value
wkB = Cells(r0, 2).Value
For r1 = r0 To LastRow
If Cells(r1, 3) = xlNull Then
If wkA = Cells(r1, 1).Value And wkB = Cells(r1, 2).Value Then
→ここのif文ですが、r1には1が代入されると思います。
　wkAとwkBと同じセルを最初みると思いますが、
　For文で全てのセルを対象とした場合は見てないですよね？？
Cells(r1, 3) = "1"
Cells(r1, 2).Interior.ColorIndex = 6
Else
End If
End If
Next r1
End If
Next r0
End Sub

最終的な目的は、A列とB列をみて、
A列　　B列
1　　　aaa 重複
1　　　aaa 重複
1 aaa 重複
2　　　aaa　重複
2　　　aaa　重複
2　　　aaa 重複
3　　　bbb
3　　　bbb
3　　　bbb
5 aaa 重複
5 aaa 重複

上記のような処理をしたいと思っております。
自分でもいただいた内容を元に作成してみます。

回答No.1

zap35

条件付き書式で十分ではありませんか。
ただし条件が不足しています。それは重複している行は全て網掛けにするのか、後から出現した行のみを網掛けにするのかが書かれていないのです。

ここでは後から出現した行だけを網掛けにする方法を説明します
質問のデータ例を少し変えました。以下のようなデータがあるとき、A1セルを選択し「書式」→「条件付き書式」をせんたくし「セルの値が」を「数式が」に変更します

数式には
　=COUNTIF($B$1:$B1,$B1)-SUMPRODUCT(($A$1:$A1=$A1)*($B$1:$B1=$B1)*1)>0
を入力して「書式」で網掛けを設定します。あとはA1セルをコピーして、他のセルに「編集」→「形式を選択して貼り付け」→「書式」で貼り付けます

A列　　B列
1　　　aaa
1　　　aaa
2　　　aaa　＊
3　　　aaa　＊
3　　　bbb
4　　　bbb　＊
4　　　ccc
4　　　ccc

すると＊印をつけた行だけが網掛けになります。

補足

情報ありがとうございます。
ただ上記を試してみましたが、網掛けになる対象セルが
全く網掛けとなりませんでした。
全く無反応でした。

よく分からなくなってしまいましたが、ご教示いただいた
数式が多分間違ってるような気がします。
調べてみて、なんか違うような気がしております。
失礼かもしれませんが、上記内容は動作確認なさったものですか？？

ちょっと自分が思っているのでは、新しくデータを追加した場合、
書式を毎回コピーを行わないといけないと思いますので、
できれば簡素化したいなぁって思っておりますので、
多分条件式書式だと厳しいと思います。
マクロでなんとかしてみます。