Excel vbaで特定の文字以外が入っている時、メッセージを表示させるプログラムについて

Question

お世話になっております。

Sub Macro1()
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
if Range("D" & i) <> "いちご" Then
Rows(i).Interior.ColorIndex = 6
End If
Next i
End Sub

この度、こちらのプログラムに特定の文字が入っている時にメッセージを表示させたく、
どの様なプログラムの構成になるのかご質問させていただきました。
例えば[スイカ]と入力されている時、「口腔アレルギー症候群の原因となる食品があります」としたいです。

よろしくお願いいたします。

Qchan1962 · Accepted Answer

＃３です。
先の回答で複数対象にする場合は、FindNextを使用しますが、
＞現在使用しているプログラムの中に、スイカと入力されている場合メッセージを
＞表示させるプログラムを追記したいのですが、それは可能なのでしょうか？

ご質問のコードに追加する場合は、下記のような感じです。

Option Explicit
Sub Macro1()
Dim i As Long, flag As Boolean
Dim keyWord As String, AnsComment As String, msg As String
keyWord = "スイカ"　　　　　　　'ここにセルを指定すれば、セルの値から設定できます。
AnsComment = "口腔アレルギー症候群の原因となる食品があります"　　'ここにセルを指定すれば、セルの値から設定できます。
　　flag = True
　　For i = 1 To Cells(Rows.Count, 4).End(xlUp).Row
　　　　If Range("D" & i) <> "いちご" Then Rows(i).Interior.ColorIndex = 6　　'行を黄色くしている
　　　　If Range("D" & i) = keyWord Then
　　　　　　If flag = True Then msg = AnsComment & vbCrLf & vbCrLf: flag = False
　　　　　　Cells(i, 4).Interior.ColorIndex = 3　　'赤にしている
　　　　　　msg = msg & keyWord & "は、" & i & "行目にあります。" & vbCrLf
　　　　End If
　　Next i
　　msg = msg & vbCrLf & "確認：対象のセル色を赤にしました。"
　　MsgBox msg
End Sub

元のコードは、いちご以外の行は黄色くなっていますが、一応スイカのセルは赤にしました。
各色については、変更してください。（いちごは無くしてよかったのかな？）

めぐみん_ · Answer

別に「スイカ」が存在しているかが知りたいだけならループ内で調べる必要はないと思いますけど。
見つかったらその都度メッセージを出す（その他の処理を行う）というなら別ですが。

Sub Macro1()
Dim i As Long
Dim n As Long

n = Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To n
If Range("D" & i) <> "いちご" Then
Rows(i).Interior.ColorIndex = 6
End If
Next i

If WorksheetFunction.CountIf(Range("D1:D" & n), "スイカ") > 0 Then _
MsgBox "口腔アレルギー症候群の原因となる食品があります"

End Sub

それより気になるのは、

＞Rows(i).Interior.ColorIndex = 6

本当に列の端から端まで塗りつぶす必要があるのでしょうか？
例えば表がＡ～Ｇ列を範囲として使用しているのなら、

Intersect(Rows(i), Range("A:G")).Interior.ColorIndex = 6

と、指定した行列が交差する部分だけを塗りつぶすようにするのが良いかと思いますよ。

Qchan1962 · Answer

こんばんは、横から失礼します。
スイカは沢山ありますか？
一つであれば、こんな書き方も出来ます。
違った探し方ですが、、

Sub sample()
　　Dim FindRange As Range, AnsObj As Range
　　Dim KeyWord As String, AnsComment As String
　　Set FindRange = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row)　’書き方色々ですがDを強調したく、、D列の最終行までの範囲
　　KeyWord = "スイカ"　'ここにセルを指定すれば、セルの値から設定できます。
　　AnsComment = "口腔アレルギー症候群の原因となる食品があります" 'ここにセルを指定すれば、セルの値から設定できます。
　　Set AnsObj = FindRange.Find(KeyWord, LookAt:=xlWhole)　’FindでFindRange内のKeyWordを探します。
　　If AnsObj Is Nothing Then　’なければ何もしない
　　Else
　　　　Range(Cells(AnsObj.Row, 1), Cells(AnsObj.Row, 4)).Interior.ColorIndex = 6
'　　　　Rows(AnsObj.Row).Interior.ColorIndex = 6
　　　　MsgBox AnsComment & vbCrLf & vbCrLf & KeyWord & "は" & AnsObj.Row & "行目にあります"
　　End If
End Sub

めぐみん_さんのアドバイスにあるように
Keyword = "スイカ"やコメント　口腔アレルギー症候群の原因となる食品があります　は、
ケースとして　他のメロンとかに対応する場合に表などに入れて置くのが良いと思います。なので一応変数にしました。（改造しやすいように）
セルにリストを作りそのセルの値をKeyWordにして、KeyWordで表からAnsCommentを抽出するとか、、
（必要ないかもしれませんが）

参考まで

neKo_deux · Answer

例えば、

Sub Macro1()
dispmsg=false
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
if Range("D" & i) <> "いちご" Then
Rows(i).Interior.ColorIndex = 6
dispmsg=true
End If
Next i
if dispmsg=true then
MsgBox "口腔アレルギー症候群の原因となる食品があります"
endif
End Sub

とか？

めぐみん_ · Answer

＞例えば[スイカ]と入力されている時、「口腔アレルギー症候群の原因となる食品があります」としたいです。

これが１０個位の物ならコードの中に書けるでしょうし、頻繁に内容が変わるとか２０や５０や１００個と言うならその対になる一覧表をシートに準備する方が良いでしょうし、
更に数千～とかならデータベースを用いるのも手ですよね。（データの入力はそれはそれで覚えなきゃでしょうけど）

必要とする情報量によってやり方は違うと思いますよ。

＞メッセージを表示させたく、

メッセージボックスで表示させるのか、どこかのセルの値としてなのか。。。はキチンと記載した方が宜しいかと。
セルに入れるなら『どこのセル（列）なのか』とかね。

Excel vbaで特定の文字以外が入っている時、メッセージを表示させるプログラムについて

＃３です。

別に「スイカ」が存在しているかが知りたいだけならループ内で調べる必要はないと思いますけど。

こんばんは、横から失礼します。

例えば、

＞例えば[スイカ]と入力されている時、「口腔アレルギー症候群の原因となる食品があります」としたいです。

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング