マクロ 検索できなかった検索値を表示したい

質問

C列を複数の検索値で検索して見つからなかった検索値が
一つでもあればその検索値をメッセージBOXに表示した上で
どの検索値であっても同じ処理をしたいです。
全て検索できた場合は別の処理をしたいです。
今自力で出来るのは以下の記述ですが
同じ処理を6回も記述しておりメンテしにくいです。
また、記述順で最初に見つからなかった検索値だけしか
表示できない（それでも問題は無いです）という弱点もあります。
他に方法はありますでしょうか？
配列関連は自力で作成出来ませんので他の方法にてアドバイスを
いただけたらと思います。

C列には果物名がランダムに10,000行入力されています。
検索値を
・みかん
・りんご
・バナナ
・いちご
・すいか
・メロン
としてそれらが全て存在するか検索し一つでも存在しない場合は
その検索値をメッセージBOXに表示した上で
どの検索値であっても同じ処理を行う。
全て検索できた場合は次の処理を行う。

Sub 実験2()

Dim 範囲
Set 範囲 = ThisWorkbook.Worksheets("マスタ").Columns("C:C")

Set rngFind = 範囲.Find("みかん")
If rngFind Is Nothing Then
MsgBox "ファイル【みかん】が取込まれていません。", vbExclamation, "【警告】"

MsgBox "今までの作業を保存しないで" & vbCrLf & _
"プログラムを終了します", vbExclamation, "終了"
MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _
"必ず【マスタ更新】をやり直してください。", _
vbExclamation, "注意してください"
ThisWorkbook.Sheets("マスタ").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ThisWorkbook.Sheets("メニュー").Select
Range("A2").Select
End '終了

End If

Set rngFind = 範囲.Find("りんご")
If rngFind Is Nothing Then
MsgBox "ファイル【りんご】が取込まれていません。", vbExclamation, "【警告】"

MsgBox "今までの作業を保存しないで" & vbCrLf & _
"プログラムを終了します", vbExclamation, "終了"
MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _
"必ず【マスタ更新】をやり直してください。", _
vbExclamation, "注意してください"
ThisWorkbook.Sheets("マスタ").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ThisWorkbook.Sheets("メニュー").Select
Range("A2").Select
End '終了

End If

Set rngFind = 範囲.Find("バナナ")
If rngFind Is Nothing Then
MsgBox "ファイル【バナナ】が取込まれていません。", vbExclamation, "【警告】"

MsgBox "今までの作業を保存しないで" & vbCrLf & _
"プログラムを終了します", vbExclamation, "終了"
MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _
"必ず【マスタ更新】をやり直してください。", _
vbExclamation, "注意してください"
ThisWorkbook.Sheets("マスタ").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ThisWorkbook.Sheets("メニュー").Select
Range("A2").Select
End '終了

End If

Set rngFind = 範囲.Find("いちご")
If rngFind Is Nothing Then
MsgBox "ファイル【いちご】が取込まれていません。", vbExclamation, "【警告】"

MsgBox "今までの作業を保存しないで" & vbCrLf & _
"プログラムを終了します", vbExclamation, "終了"
MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _
"必ず【マスタ更新】をやり直してください。", _
vbExclamation, "注意してください"
ThisWorkbook.Sheets("マスタ").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ThisWorkbook.Sheets("メニュー").Select
Range("A2").Select
End '終了

End If

Set rngFind = 範囲.Find("すいか")
If rngFind Is Nothing Then
MsgBox "ファイル【すいか】が取込まれていません。", vbExclamation, "【警告】"

MsgBox "今までの作業を保存しないで" & vbCrLf & _
"プログラムを終了します", vbExclamation, "終了"
MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _
"必ず【マスタ更新】をやり直してください。", _
vbExclamation, "注意してください"
ThisWorkbook.Sheets("マスタ").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ThisWorkbook.Sheets("メニュー").Select
Range("A2").Select
End '終了

End If

Set rngFind = 範囲.Find("メロン")
If rngFind Is Nothing Then
MsgBox "ファイル【メロン】が取込まれていません。", vbExclamation, "【警告】"

MsgBox "今までの作業を保存しないで" & vbCrLf & _
"プログラムを終了します", vbExclamation, "終了"
MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _
"必ず【マスタ更新】をやり直してください。", _
vbExclamation, "注意してください"
ThisWorkbook.Sheets("マスタ").Select
Cells.Select 'Sheets
Selection.Delete Shift:=xlUp
Range("A1").Select
ThisWorkbook.Sheets("メニュー").Select
Range("A2").Select
End '終了

End If
次の処理
End Sub

回答No.1

keithin · ベストアンサー

sub macro1()
　dim 範囲 as range, rngFind as range
　dim i as integer
　dim a as variant
　a = array("みかん","りんご","バナナ","いちご","すいか","メロン")
　set 範囲 = thisworkbook.worksheets("マスタ").range("C:C")

　for i = 0 to ubound(a)

’以下はオリジナルの流用
　　Set rngFind = 範囲.Find(a(i))
　　If rngFind Is Nothing Then
　　MsgBox "ファイル【" & a(i) & "】が取込まれていません。", vbExclamation, "【警告】"

　　MsgBox "今までの作業を保存しないで" & vbCrLf & _
　　"プログラムを終了します", vbExclamation, "終了"
　　MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _
　　"必ず【マスタ更新】をやり直してください。", _
　　vbExclamation, "注意してください"
　　ThisWorkbook.Sheets("マスタ").Select
　　Cells.Select
　　Selection.Delete Shift:=xlUp
　　Range("A1").Select
　　ThisWorkbook.Sheets("メニュー").Select
　　Range("A2").Select
　　End '終了

　　End If
　next i
end sub

＃実際にはみかんやりんごなどの生データはプログラム中にコーディングせず，チェック対象データとして一枚シートを用意してデータとして記入しておいて，巡回してチェックするような仕込みが推奨と思います。

お礼

お礼が遅れてすいません。
上手く対応できました。助かりました。
どうもありがとうございました。

回答No.2

jcctaira

gx9wxさん　こんにちは。
以下の処理でできるかと思います。

Sub 実験2()
　Dim I　　　　　　 As Integer
　Dim 検索ファイル　As Variant
　Dim 未取得　　　　As String

　検索ファイル = Array("みかん", "りんご", "バナナ", "いちご", "すいか", "メロン")
　With ThisWorkbook.Worksheets("マスタ")
　　For I = 0 To UBound(検索ファイル)
　　　If .Range("C:C").Find(検索ファイル(I)) Is Nothing Then
　　　　未取得 = 未取得 & vbCrLf & "・" & 検索ファイル(I)
　　　End If
　　Next I
　　If 未取得 <> "" Then
　　　MsgBox "以下のファイルが取り込めていません。" & 未取得, vbExclamation, "【警告】"
　　　MsgBox "今までの作業を保存しないで" & vbCrLf & _
　　　　　　 "プログラムを終了します", vbExclamation, "終了"
　　　MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _
　　　　　　 "必ず【マスタ更新】をやり直してください。", vbExclamation, "注意してください"
　　　.Select
　　　Cells.Delete Shift:=xlUp
　　　Range("A1").Select
　　　ThisWorkbook.Sheets("メニュー").Select
　　　Range("A2").Select
　　　Exit Sub '終了
　　End If
　End With
　' 全て検索できた場合は次の処理を行う。
　' 　　　　↓
End Sub

お礼

お返事送れてすいません。
思ったとおりに動きました。
ありがとうございました。