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ベストアンサー
- 回答日時:
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
- 回答日時:
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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
- Visual Basic(VBA) 【変更】ファイルを閉じてダイアログで保存した時、更新したシートだけの処理の実行をする 5 2022/03/26 18:31
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
- Visual Basic(VBA) vbaを早くしたい 5 2022/09/09 10:58
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Visual Basic(VBA) VBAで実行時エラー'424' オブジェクトが必要ですと出る 2 2022/10/07 09:25
- Visual Basic(VBA) ファイル全てを .xlsm に変更したところ、プログラムが途中で落ちてしまっています 17 2022/12/07 12:03
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 2 2023/05/23 16:28
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
パワーポイントのレイアウトで...
-
実行時エラー -2147217900 ADO...
-
パワーポイント画面にそのファ...
-
パワーポイント 配布資料で印...
-
Accessの式の「!」エクスクラメ...
-
PowerPointでのタイトル位置の指定
-
パワーポイントでスライドマス...
-
PPTにおけるページ数のポイント
-
パワーポイントでこんなことで...
-
PowerPointで貼り付けた絵など...
-
PowerPointフッターの文字の大...
-
pdf スライドをA4上下2段で配...
-
スライドマスタごとスライドを...
-
パワーポイントのヘッターフッ...
-
パワーポイント初心者です
-
CDへのデータ書き込み方式について
-
Power Pointでタイトルマスター...
-
PowerPointでスライドマスタの...
-
PPTスライド番号の設定
-
★PowerPoint 配布資料で右側に...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
パワーポイントのレイアウトで...
-
パワーポイント 配布資料で印...
-
パワーポイント画面にそのファ...
-
実行時エラー -2147217900 ADO...
-
Accessの式の「!」エクスクラメ...
-
PowerPointでスライドマスタの...
-
パワーポイントでスライドマス...
-
Powerpoint の フッター??...
-
pdf スライドをA4上下2段で配...
-
POWER POINTの背景が保存されて...
-
★PowerPoint 配布資料で右側に...
-
エクセル VLOOKUP ほかのエクセ...
-
パワーポイント 欄外社名削除
-
PowerPoint フッターが改行さ...
-
パワーポイント スライドの拡大
-
2つのシートを連動させたいです
-
PowerPointでのページ番号挿入
-
パワーポイントで全てのフォン...
-
パワーポイントで全てのページ...
-
PowerPointで貼り付けた絵など...
おすすめ情報