VBAでの指定セルに対し指定した文字以外の重複に色とメッセージを表示させるプログラム

お世話になっております。

この度顧客リストの管理表で自動化したい処理がございます。
一つ目の処理は、ボタンをクリックしますとK4セルから末尾までに「-」半角ハイフン以外の
重複があった時、その行セルに赤色をつけメッセージを表示。(範囲はA～Mセル)

二つ目はprivate sub worksheet_changeを使うことは分かったのですが、
M4セルから末尾までに半角ハイフン以外の入力が行われた際、こちらも重複があれば
同じくメッセージを表示させるプログラムを構築したいご質問になります。

ご教示いただけると幸いです。
よろしくお願いいたします。

No.1 ベストアンサー 回答者： zongai 回答日時： 2020/10/27 07:09

一つ目

ボタンを押すと、K4から順番に重複セルを数え、
2個以上の場合着色。
着色処理が生じた場合、メッセージを表示。

Sub ボタン1_Click()
　　saigo = Range("K4").End(xlDown).Row
　　chk = 0
　　For i = 4 To saigo
　　　　If Range("K" & i) <> "-" Then
　　　　　　kosu = Application.WorksheetFunction.CountIf(Range("K4:K" & saigo), Range("K" & i))
　　　　　　If kosu > 1 Then
　　　　　　　　Range("K" & i).Interior.Color = RGB(255, 0, 0)
　　　　　　　　chk = 1
　　　　　　End If
　　　　End If
　　Next
　　If chk = 1 Then MsgBox "重複があります"
End Sub


二つ目
M列で入力があった場合、入力された値と重複したセルを数え、
2個以上の場合、着色するしメッセージを表示。
一つ目と違い、入力された値の重複のみチェックする。

Private Sub Worksheet_Change(ByVal Target As Range)
　　
　　saigo = Range("M4").End(xlDown).Row
　　If Intersect(Target, Range("M4:M" & saigo)) Is Nothing Then
　　　　Exit Sub
　　ElseIf Target = "-" Then
　　　　Exit Sub
　　Else
　　　　kosu = Application.WorksheetFunction.CountIf(Range("M4:M" & saigo), Range(Target.Address(False, False)))
　　　　If kosu > 1 Then
　　　　　　For i = 4 To saigo
　　　　　　　　If Range("M" & i) = Range(Target.Address(False, False)) Then
　　　　　　　　　　Range("M" & i).Interior.Color = RGB(255, 0, 0)
　　　　　　　　End If
　　　　　　Next
　　　　　　MsgBox "重複あり"
　　　　End If
　　End If
End Sub


両方で、セル範囲の最終行を「saigo」という変数に入れていますが、
K列、M列で重複チェック該当範囲に空白が無いことを前提にしています。
行数が決まっているなら、直接指定してもいいです。

とりあえず、プログラム検討の叩き台になれば幸いです。

この回答へのお礼

zongai様、回答いただきありがとうございます。

こちらのプログラムで理想の動きが実現できました。
活用させていただきます。

今後ともこちらに何かとお世話になるかと
存じますが、よろしくお願いいたします。
この度はありがとうございました。

お礼日時：2020/10/28 16:39

No.2 回答者： めぐみん_ 回答日時： 2020/10/27 08:42

この質問で気になるのは『Ｋ列とＭ列の扱いの違い』ですかね。

リスト範囲がＡ～Ｍ列であるなら入力も同じ範囲なのでは？
なのに片方はボタンでイベントでもう片方は値の変更でってのですと、前者は押し忘れがあったらイベント発生はない訳ですがそこはポカミス対策がされているのでしょうか？
⇒重複がなかった場合もメッセージを出しているとか？

或いはＭ列を除く他の部分は別のシートなどからの転記とかなのかな？

この回答へのお礼

めぐみん様、お世話になっております。

めぐみん様の仰る通り、指定範囲はA~M列でございます。
ご指摘ありがとうございます。
こちらは
Intersect(Rows(i), Range("A:M")).Interior.ColorIndex = 3
のコードで対応できました。

お礼日時：2020/10/28 16:14