特定の文字に対してポップアップ表示

質問

エクセルvbaでセルに特定の文字を含む文字が入力された時に、ポップアップを表示するようにしたいのですが、特定の文字とメッセージ内容は"設定用シート"内のA列に特定の文字、B列にメッセージ内容をセット。
下記のコードでは動作致しません。
どのように修正すれば宜しいでしょうか？
Worksheet_Change(ByVal Target As Range)
Dim searchRange As Range
Dim cell As Range
Dim searchText As String
Dim message As String

' 設定用シートを参照
Set searchRange = Sheets("設定用シート").Range("A:B")

' 変更されたセルの中で特定の文字を検索
For Each cell In Intersect(Target, Me.UsedRange)
searchText = cell.Value
If Not IsEmpty(searchText) Then
' 設定用シートで特定の文字を検索
On Error Resume Next ' セルが見つからなかった場合のエラーハンドリング
message = searchRange.Columns(2).Find(searchText).Offset(0, 1).Value
On Error GoTo 0 ' エラーハンドリングを元に戻す

If Len(message) > 0 Then
' ポップアップ表示
MsgBox message, vbInformation, "メッセージ"
End If
End If
Next cell
End Sub

回答No.4

kkkkkm · ベストアンサー

回答No.2の補足です。

複数のセルを一括でコピペした時に対応するため的な感じでFor Eachでループしてるのだとしたら納得です。

お礼

やりたい事ができました！！ありがとうございました。

回答No.3

imogasi

何も難しいことはないと思うが。下記を参考に。
Private Sub Worksheet_Change(ByVal Target As Range)
f = "xx" '適宜変えること=質問の特定の文字
If Intersect(Target, Range("a1:B10")) Is Nothing Then
Else
x = InStr(Target, f)
If x <> 0 Then
MsgBox x & "文字目以下に検索文字" & f & "あり"
End If
End If
End Sub

回答No.2

kkkkkm

回答No.1の追加です。

ふと思ったのですが、私の知識不足でFor Each でループしているのが何故なのか分からないので
たとえば以下のようにループしない方法だとまずいのでしょうか。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim searchRange As Range
Dim FRng As Range

If Intersect(Target, Me.UsedRange) Is Nothing Then
Exit Sub
End If
'↑UsedRangeでしたらこの部分もなくていいような気もしますが

' 設定用シートを参照
Set searchRange = Sheets("設定用シート").Range("A:A")

' 変更したセルの特定の文字を検索
Set FRng = searchRange.Find(Target.Value)
If FRng Is Nothing Then
Set searchRange = Nothing
Exit Sub
End If
' ポップアップ表示
MsgBox FRng.Offset(0, 1).Value, vbInformation, "メッセージ"
Set searchRange = Nothing
End Sub

余計なお世話&疑問ですみません。

回答No.1

kkkkkm

message = searchRange.Columns(2).Find(searchText).Offset(0, 1).Value
は
message = searchRange.Columns(1).Find(searchText).Offset(0, 1).Value
じゃないでしょうか。