エクセルマクロを使用して異なるセルの重複データを探したい

質問

エクセルに以下のような値が入力されています。
A～Bは列番号
1～100は行番号

1　A B
2　11 14
3　12 15
4　13 13
.
100行まで続く

A1からB100までに入力された値の中で、重複している値のセルを探して、セルの色を変えたいと考えています。
VBAを使って処理したいのですが、どなたかご教授頂けないでしょうか。宜しくお願いいたします。

回答No.4

ChateauAres · ベストアンサー

重複チェック用に COUNTIF関数が用意されているので、これを利用した方法です。

Ｃ列にＡ列の、Ｄ列にＢ列のCOUNTIF関数の結果を出力します。
Ｃ列・Ｄ列はマクロ用のダミーなので、後で列を非表示にしておけばよいです。

C1には =COUNTIF($A$1:$B$100,A1)
D1には =COUNTIF($A$1:$B$100,B1)
と設定し、C2からC100まで　ドラッグでコピーします。
D2からD100も同様です。

マクロはC列およびD列の値をみて、A列B列のセル背景色を変更します。
この方法の利点は重複箇所の数に応じて色を変えるのが簡単なことです。

Dim i As Integer
Dim j As Integer

For i = 1 To 100
For j = 3 To 4
'重複箇所が２箇所なら
If Cells(i, j) = 2 Then
Cells(i, j - 2).Interior.ColorIndex = 6 ' 黄色
Else
'重複箇所が３箇所以上なら
If Cells(i, j) >= 3 Then
Cells(i, j - 2).Interior.ColorIndex = 8 'シアン
Else
' 色をつけない
Cells(i, j - 2).Interior.ColorIndex = xlNone
End If
End If
Next j
Next i

ご参考まで

お礼

ご回答ありがとう御座います。
3箇所以上の場合まで考慮頂き、大変感謝申し上げます。
求めていた結果が得られましたが、もしかしたら列の追加がネックになる可能性もあるので十分検討したうえで利用させて頂きます。

回答No.5

imogasi

これは条件付き書式によるべきだ。
・簡単性
・データ変更即時反応性(これが理由として大きい）
・エクセルの貴重な機能を生かす
からお勧め。
ーー
例データ　－は空白を便宜的に表す
A列　　　B列
ー ー
11 14
12 15
13 13
23 18
24 23
11 5
9 15
A2:B10（現データより余分でもよい）を範囲指定
A2をアクチブにして
書式ー条件付き書式ー数式が
=COUNTIF($A$2:$B$10,A2)>1
書式を適当に設定
OK
ーーー
VBAの形式に刷る必要があれば、上記の操作でマクロの記録をとる方法もある。

お礼

ご回答ありがとう御座いました。
とても良い方法だったのですが、別の条件付き書式の指定があり、AND関数が上手く使えない状況でしたので、今回は別の方法でクリアさせて頂きました。

回答No.3

kikujack

下記のコードはどうでしょうか。

For i = 1 To 100
If Cells(i, 1) = Cells(i, 2) Then
Rows(i).Interior.ColorIndex = 8
End If
Next

お礼

ご回答ありがとう御座います。
早速試してみました。
行全体に色がついてしまうので、セルだけに色がつけられるよう考え中です。

回答No.2

K-Sogacchi

とりあえず、あまり深く考えていない仕様ではありますが、
ループして検索する場合のヒントを書いてみます。
いきなり答えだけ書いても身に付きませんので。
（もっと利口なやり方もあるかもしれませんが、それについては他の方に…（汗））

・For～Next等でループ
　まず、ループして検索する際、検索元となるセルを示す値でループし、
　そのループの中で更に、検索先（比較対象）のセルを示す値でループする
　必要があります。
　今回の場合、列が２つあるので、その対応も行わなければいけませんが、
　それについてもやり方は複数あります。
　思いついたのを少しだけ…
　例1.検索元のループは1～200として、対象セルは、100以下の場合はA列内、
　　　101以上の場合はB列内（ループカウンタから100を引いた値が対象行）とする
　例2.Do～Loopループを使用し、ループごとにカウンタ変数に1を足していって
　　　対象行を移動させていき、100を超えたら対象列を移動した上で対象行は1に戻す
　　　（ループ終了条件は別途考えてください）
・検索条件等について
　上で書いた検索元と検索先のループは、両方100×2ずつループさせても
　動くには動きますが、無駄が多くなり、処理が遅くなります。
　1つ目の検査が終了したら、2つ目を検査する際には、1つ目との比較は不要ですので、
　その辺をうまく定義すれば処理速度が数段向上します。
　また、当然ながら比較元と比較先が同じセルを指している場合は比較してはいけませんし
　（上の最適化が間違いなければ、これは考える必要ありませんが）、既に色が
　変わっているセルも比較する必要はありません。

このヒントを元に考えてみて、それでも分からなければ追記して頂ければ良いかと。

お礼

アドバイスありがとう御座います。
参考にさせて頂きます。

回答No.1

fumufumu_2006

こんなのはどうでしょうか？

Sub sample()
Dim r As Integer
'1～100行
For r = 1 To 100
'A列のデータが""でなくA列とB列が同じければ
If (Cells(r, 1) <> "") And (Cells(r, 1) = Cells(r, 2)) Then
'背景赤
Cells(r, 1).Resize(1, 2).Interior.ColorIndex = 3
Else
'背景なし
Cells(r, 1).Resize(1, 2).Interior.ColorIndex = xlNone
End If
Next
End Sub

補足

早速のご回答ありがとう御座います。
私の質問が言葉足らずでしたので補足させて頂きます。
A列とB列の1行目から100行目までの全てのセルの中から重複データを探したいと考えております。
重複データは必ずしも隣のセルにあるとは限らず、A1とA5にある可能性もあれば、A2とB3にある場合もあります。
ややこしい話で大変申し訳御座いませんが、以上の状況を加味した上でアドバイスを頂ければ幸いに存じます。
宜しくお願い申し上げます。