EXCELでの重複入力禁止を実現するVBAについて

質問

EXCELの重複入力禁止についての質問です。
重複入力禁止は、大きく分けて関数、入力規則を使っての設定と、VBAを使って設定の２つに分かれると思いますが(違っていたらすいません)今回、予め入力規則を設定しているセルに対し、重複入力の禁止を設定したいため、VBAで実現したいと考えています。
設定したいのは、A列、B列の2列を対象として、同じ内容の行がある場合はエラー表示させて、重複しているシートを赤く塗りつぶすような動作を考えています。例えば、A1とA2は一致するが、B1とB2が異なるといった一列だけの判断ではなく、A1、B1の内容とA2、B2に入力している内容が完全に一致した場合、エラー表示させて、A1、B1、A2、B2セルを赤く塗りつぶす動作になります。（2列１行という言い方が正確かどうかわかりませんが、上記のような内容を希望しています。）
また、空白は対象外と考えます。
上記のようなVBAを作成したいのですが、当方まだまだVBAを勉強段階で自分でソースを作成することが難しいです。
ソースを教えて頂けないでしょうか？
また、可能であれば、A、B、C３列を対象としたVBAについても教えていただけると非常に助かります。

回答No.5

argument

こんばんわ　061156　さん
「人非聖賢，孰能無過」という訳ではありませんが、正しく動かねば言えば良いのです。
はい。全力で回答が間違っていましたね。
といっても、自分でソース書かず削除対象の作成丸投げ依頼なため悪びれもせずに回答します。
A、B、C一行をワンセットとして、行ごとの一致行の着色です。
以下を標準モジュールに張ってください。

Sub colorcheckline()
maxliney = 0: For i = 65 To 67
If maxliney <= Range(Chr(i) & "65536").End(xlUp).Row Then maxliney = Range(Chr(i) & "65536").End(xlUp).Row
Next
For i = 1 To maxliney
For j = 1 To maxliney
If Not i = j Then If Range("A" & i).Value & vbTab & Range("B" & i).Value & vbTab & Range("C" & i).Value = Range("A" & j).Value & vbTab & Range("B" & j).Value & vbTab & Range("C" & j).Value Then Range("A" & i).Interior.ColorIndex = 3: Range("B" & i).Interior.ColorIndex = 3: Range("C" & i).Interior.ColorIndex = 3: Range("A" & j).Interior.ColorIndex = 3: Range("B" & j).Interior.ColorIndex = 3: Range("C" & j).Interior.ColorIndex = 3:
Next
Next
End Sub

はい。実行してみましたか？A、B、C一行をひとつのデータをとし、重複する内容の全ての行が着色されました。
tabを挟むのは、入力が「AAA」「AA」「AA」の場合「A」「AAA」「AAA」の判定の為です(どちらもただ連結比較すると「AAAAAAA」で一致と誤認するため)
もしも一致しなくなった場合で色を戻す場合else条件で0を渡すだけですので勝手に改造してください。また、Changeイベントにしたいのならそれくらいは勉強してくださいね。

追加処理・処理違い・補足等あればいってください。

回答No.4

argument

ほむ。ソースが欲しいだけですか？ならばあげましょう。
ではこれを標準モジュールこぴぺしてください。
実行すればA列B列C列の重複する部分だけ赤くなります。

Sub colorcheck()
flag = Array(1, 1, 1): linex = Array("", "", ""): For i = 1 To 65536
If flag(0) Then If Range("a" & i).Value <> "" Then linex(0) = linex(0) & Range("a" & i).Value & vbCrLf Else flag(0) = 0
If flag(1) Then If Range("b" & i).Value <> "" Then linex(1) = linex(1) & Range("b" & i).Value & vbCrLf Else flag(1) = 0
If flag(2) Then If Range("c" & i).Value <> "" Then linex(2) = linex(2) & Range("c" & i).Value & vbCrLf Else flag(2) = 0
If (flag(0) = 0) And (flag(2) = 0) And (flag(2) = 0) Then Exit For
Next
For i = 0 To UBound(linex): linex(i) = Split(linex(i), vbCrLf): Next
For i = 0 To UBound(linex)
For j = 0 To UBound(linex(i)) - 1
For k = 0 To UBound(linex)
For l = 0 To UBound(linex(k)) - 1
If Not ((i = k) And (j = l)) Then
If Cells(j + 1, i + 1) = Cells(l + 1, k + 1) Then Cells(j + 1, i + 1).Interior.ColorIndex = 3: Cells(l + 1, k + 1).Interior.ColorIndex = 3
End If
Next
Next
Next
Next

余りに即席で考えなしに作り出したので無駄が多いです。読みやすい記述の仕方も一切していません。でも大切なのは結果です。あなたが中身がたとえ分からなくても処理の答えが得らればよいでしょう？
デバッグは一回しか実行してませんがまぁ動くでしょう。

仕様
A列空白までカウント・B列空白までカウント・C列空白までカウント
(最初の空白にヒットした時点でカウントをやめます）
A1とA2…C最後まで比較。次はA2からC最後まで比較。

既に赤くしたところはカラープロパティを取得しスキップしようと思いましたがめんどくさいのでやめました。どうせ変わるのは早さだけで結果は変わりません。

速度以外で処理的に修正が欲しいならば書き直します。

回答No.3

imogasi

同じデータを入れるとセルに色をつける
A列と仮定します
条件付書式の
「数式が」、で
=AND(A1<>"",COUNTIF(A:A,A1)<>1)
ーー
キワモノ的ですが、別列に第１行に＝A１といれ、下方向に式を複写する。
A列に別の条件付書式が入っておれば、その別列に対し、条件付書式を、例えば重複入力禁止なら、上記の式で設定しては。
ーー
VBAでですが、VBAのイベントというものを使った経験ありますか。
無いというレベルでは、本質問は荷が重いはず。人に作ってもらって使うだけということになり、本質問コーナーでは歓迎されません。
ーー
（１）ChangeイベントでTargetセルの値が他に無いか重複を全行
比較する
（２）入力済みセル全体を対象として、Findメソッドをかけて見つかれば、警告（セルの色づけ）、見つからなければOK
参考
http://excelvba.pc-users.net/fol7/7_1.html
２つ以上出現するかどうか調べる必要が無いので、この質問で楽です。
（３）WorksheetFunctionのCOUNTIF関数を使う手もあります。
（後記のように不完全例）
G列に入力の例
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 7 Then Exit Sub
d = Range("G65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("G2:G" & d), Target) > 1 Then
Target.Interior.ColorIndex = 6
Else
Target.Interior.ColorIndex = xlNone
End If
End Sub
ーーー
しかし今入力した値がダブっているのは判別しやすいのですが、
上から上書きしたときの元の値とダブっていると言うことで色が付いていたセルの色を消すのが難しい。
入力前の既入力の値が捉えにくいこともある。
ーー
結局、初歩的な方法では
毎回入力されるごとに第１（最上行）から最下行まで、全てのセルに
ついて、CountIFナリで重複をチェックするロジックにする必要があるようだ。
この上記結論は小生の思考不足であるかもと懸念はあるが。

お礼

貴重なご意見ありがとうございました。
まだまだ、VBAは勉強段階ですので、内容がなかなか理解できないです。
もう少し勉強してみます。

回答No.2

mshr1962

#1です。すみません。数式に">1"を付け忘れました。また
>空白は対象外と考えます。
を抜かしてました。
2列なら、A1:B1を選択して「書式」「条件付き書式」
「数式が」「=AND(COUNTBLANK($A1:$B1)=0,(COUNTIF($A:$A,$A1)*COUNTIF($B:$B,$B1))>1)」で書式ボタンでパターンで色を選択
としてください。

ちなみにEXCEL2007なら新しい関数COUNTIFSが使えます。
「数式が」「=AND(COUNTBLANK($A1:$B1)=0,COUNTIFS($A:$A,$A1,$B:$B,$B1)>1)」
になるので便利かと思います。

お礼

回答ありがとうございました。
VBAでもできないか勉強してみます。

回答No.1

mshr1962

条件付き書式でできます。
2列なら、A1:B1を選択して「書式」「条件付き書式」
「数式が」「=COUNTIF($A:$A,$A1)*COUNTIF($B:$B,$B1)」で書式ボタンでパターンで色を選択

3列なら、A1:C1を選択して「書式」「条件付き書式」
「数式が」「=COUNTIF($A:$A,$A1)*COUNTIF($B:$B,$B1)*COUNTIF($C:$C,$C1)」で書式ボタンでパターンで色を選択