エクセル 入力規則のＶＢＡを教えてください

質問

先日も質問させていただきましたが、どうしてもうまくいかないので、再度質問させていただきます。

エクセルで顧客管理をしています。
Ｃ列に顧客名を入力していくのですが、
同じ顧客のデータは１行にまとめたいため、
Ｃ列には同じ名前が入力できないようにしたいのです。

Ｃ列全部に
データ→入力規則→設定→数式　　=countif(c:c,c1)=1
と、入力規則を設定しました。
この後、ダブリ入力をすると警告のメッセージボックスが出るようになったのですが、
中にはまったく同じ顧客名なのに入力できてしまったり、
また同じ名前はないのに、入力できなかったりします。
これは何が原因なのでしょうか？

どうしてもダブリ入力はできないようにしたいのですが、他に何か方法はないでしょうか？

前回のこの質問に対して、
式を=countif(c:c,c1)＜=1　　とするや
入力規則のコピーの方法など、お答えを頂きましたが、どうしてもうまくできませんでした。
同じく、まったく同じ顧客名なのに入力できてしまったり、
また同じ名前はないのに、入力できなかったりします。

伝票を見ながら入力していくのですが、伝票は１０００枚ほどあります。
どうしても入力時点で重複をさけたいのですが、これをＶＢＡでできないでしょうか？
入力規則のコードの書き方がわかりません・・。
いつもこちらに頼って申し訳ありませんが、どうぞよろしくお願いします。

回答No.1

pkh4989 · ベストアンサー

こんにちは。

>Ｃ列全部に
>データ→入力規則→設定→数式　　=countif(c:c,c1)=1
上記の設定代わりに、以下のマクロのみで、如何でしょうか。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim wCnt　　　　As Integer
　　Dim wStr　　　　As String
　　Dim wR　　　　 As Long
　　Dim c　　　　 As Range
　　'
　　If Target.Column = 3 Then
　　　　If Not IsEmpty(Target.Value) Then
　　　　　　wCnt = 0
　　　　　　wStr = Target.Value
　　　　　　wR = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row
　　　　　　For Each c In ActiveSheet.Range("C1:C" & wR)
　　　　　　　　If c.Value = wStr Then
　　　　　　　　　　wCnt = wCnt + 1
　　　　　　　　End If
　　　　　　Next
　　　　　　If wCnt > 1 Then
　　　　　　　　MsgBox "既に入力済です。"
　　　　　　　　Target.Value = ""
　　　　　　End If
　　　　End If
　　End If
End Sub

<マクロ貼付>
入力シートをマウス右Click → 「コードの表示」→ 表示される画面に貼り付け

回答No.3

Wendy02

こんにちは。

VBAでも、根本的には同じではないでしょうか？
こちらが見る限りは、その数式自体は、問題ないはずですから、その入力の「ブレ」ではないかと思うのです。だから、その「ブレ」をVBAに含めるなら可能ですが、単純に、VBAに置き換えても無理だと思うのです。うまく行かなかった部分を、徹底的に原因を調べるしかないですね。

今、別な式で試してみました。
C2～C65536 までを、選択し、「C2 を白抜きでアクティブになっているのを確認して」入力規則の数式を以下の入れてみました。

=COUNTIF($C$1:C1,C2)=0

こちらもうまくいきました。

回答No.2

x0000x

こんにちは。

マクロで入力規制の設定方法は、「新しいマクロの記録」で確認できますが、VBAで入力規制を設定するのみ、画面から設定するのも設定のアプローチが違うだけで、入力規制そのものには影響を与えません。

>まったく同じ顧客名なのに入力できてしまったり、
>同じ名前はないのに、入力できなかったりします。
見た目同じでも、空白の有無や、全角、半角の違いは考えられませんか？
たとえば、「aaa 」と「aaa」では、見た目同じでもcountif()=1となり、入力可能です。
また、Countif関数では、全角と半角文字の区別ができないようです。
「cc」(半角)と「ｃｃ」（全角）ではcountif()=2となります。

試しに条件書式で色設定を行い、重複しているセルを判別してみてはどうでしょうか？
メニューの「書式」－「条件付書式」で
「数式が」、「=COUNTIF(C:C,C1)>1」、「書式」の「パターン」で任意の色を選択します。
C列すべてのセルに書式をコピーします。

マクロで処理したいなら以下のコードを該当シートのマクロとして貼り付けすれば、二重チェックを行います。
（この処理の検索は、メニューの「編集」「検索」と同じ機能です。）

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And Len(Target.value) > 0 Then
'C列の場合だけ確認
Dim rng As Range
Set rng = ActiveSheet.Range("C:C").Find(What:=Target, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, MatchByte:=True)

If Not rng Is Nothing Then
'発見した。
If rng.Address <> Target.Address Then
'入力中セル以外で発見

MsgBox "他で入力済み!"
Target.value = Empty '入力値をクリア

'入力位置を補正
ActiveSheet.Cells(Target.Row, "C").Select
End If
End If
End If
End Sub