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

Question

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

keithin · Accepted Answer

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

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

jcctaira · Answer

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

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

sub macro1()

gx9wxさん こんにちは。

似たような質問が見つかりました

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

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

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

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

gx9wxさん　こんにちは。