- ベストアンサー
全シート検索マクロで終了メッセージを表示する方法
- 全シートを対象に検索するマクロを作成しています。検索が終了したときに終了メッセージを表示させたいのですが、どこにメッセージを表示させれば良いか分かりません。また、最初の表示が「次を検索します」となっているのも違和感があります。マクロに詳しい方に助けていただきたいです。
- Excelのマクロを使用して全シートを対象に検索するためのマクロを作成しましたが、検索が終了したときに終了メッセージを表示したいです。ただ、どこにメッセージを表示すれば良いか分からない状況です。また、最初の表示が「次を検索します」となっているのも違和感があります。
- Excelのマクロを使用して全シートを検索するためのマクロを作成していますが、検索が終了したときに終了メッセージを表示したいです。しかし、どこにメッセージを表示すれば良いか分からずに困っています。また、最初の表示が「次を検索します」となっているのも気になります。マクロに詳しい方にアドバイスをいただけないでしょうか。
- niftynejp
- お礼率50% (138/274)
- その他MS Office製品
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- 検索マクロ修正
ある文字を全シートから検索するマクロをこちらのサイトで以下マクロを拝見しました。 これでほぼいいのですが以下を修正するにはどうしたら宜しいでしょうか？宜しく御願いします。 (1)検索したセルに飛ぶ前にセル番地が表示されるのを無くしたい。 (2)検索結果が複数有る場合、全セルに飛んでからでないと終了出来ない。砂時計が表示されたまま。 (3)(2)と同様、間違って空白のまま検索ボタン押してしまうと永遠に終了出来ない。 Sub test01() s = InputBox("検索文字列＝") Dim sh As Worksheet For Each sh In ActiveWorkbook.Worksheets Set x = sh.Cells.Find(what:=s) If x Is Nothing Then GoTo p1 MsgBox sh.Name & x.Address b = sh.Name & x.Address sh.Activate x.Activate '--- Do Set y = sh.Cells.FindNext(after:=ActiveCell) If y Is Nothing Then GoTo p1 If sh.Name & y.Address = b Then GoTo p1 MsgBox sh.Name & y.Address y.Activate Loop p1: Next End Sub
- ベストアンサー
- オフィス系ソフト
- Excel97で全シート検索のマクロを記述するには
住所録みたいな物である文字を全シートから半角,全角,大文字,小文字を区別する事なく曖昧検索し検索されたセルが有る一行に色を塗りつぶし、又次を検索したら一行に色を塗りつぶすようにするマクロを作成するにはどのようにしたらよいでしょうか？ もし色を塗り潰すのが大変な場合は検索されたセルが有る行を選択する事によって色が変わり検索結果がわかりやすくなるマクロを作成するにはどのようにしたらよいでしょうか？ 以下マクロを教えていただき実行したのですが、ちゃんと色が付く時と、ダメな時「実行時エラー'1004': InteriorクラスのColorIndexプロパティを設定できません」とメッセージが出る時が有ります。 検索対象は各シート10～12列、全30シート計3500行くらいになります。 自分のPCはWinXP,CPU:3.06GHｚ,メモリ:1GHzですが いろいろな機種みんなで使用したくCPU:1GHｚ,メモリ:256MBくらいでも使用出来たらと思います。宜しく御願いします。 Sub 検索color() s = InputBox("検索文字列＝") If s = "" Then Exit Sub End If Dim sh As Worksheet For Each sh In ActiveWorkbook.Worksheets Set x = sh.Cells.Find(what:=s, MatchByte:=False) If x Is Nothing Then GoTo p1 b = sh.Name & x.Address sh.Activate x.Activate Rows(x.Row).Select Selection.Interior.ColorIndex = 36 x.Select '--- Do Set y = sh.Cells.FindNext(after:=ActiveCell) If y Is Nothing Then GoTo p1 If sh.Name & y.Address = b Then GoTo p1 y.Activate Rows(y.Row).Select Selection.Interior.ColorIndex = 36 y.Select Loop p1: Next End Sub
- ベストアンサー
- オフィス系ソフト
- 別のシートにあるリストを表示する方法
すみません 検索シートから生徒シートの名前を検索したら検索シートに返されるようなマクロはどの様に書けばいいでしょうか？ イメージとしては下記のような感じです。できれば左2行目3行目の検索結果も返したいです。 よろしくお願い致します。 Sub 名前検索() Dim myrange As Range Worksheets("生徒シート").Activate Set myrange = Range("C4:AG300").Find(what:=Range("C100").Value, LookIn:=xlValues) If Not myrange Is Nothing Then Worksheets("検索シート").Activate Cells(102, "C").Value = myrange.Offset(, -3).Value Else MsgBox "該当者なし" End If End Sub
- ベストアンサー
- オフィス系ソフト
- ブック全体の検索の次へは？
ブック全体を検索するマクロ作ったのですが、 ブックの最初にあるものしか見つけられません。 見つかった時に、次の検索を行うにはどのようなＶＢＡになるのでしょうか？ よろしくお願いもうしあげます。 Sub KensakuAll() 'ブック内の全シートを検索 Dim myWb As Workbook Dim mySht As Worksheet Dim myRng As Range Dim Key1 As String Key1 = InputBox("検索キーを入力しなさい") If Key1 = "" Then Exit Sub For Each mySht In Sheets Set myRng = mySht.Cells.Find(what:=Key1) If Not myRng Is Nothing Then mySht.Activate myRng.Activate Set mySht = Nothing Set myRng = Nothing Exit Sub End If Next MsgBox "該当するセルは見つかりませんでした" Set mySht = Nothing Set myRng = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル マクロ 検索
お世話になります。 範囲がA2からK221までの表があります。 検索して検索されたセルの左のセルを表示するマクロを組みたいのですが、検索する文字（数値）はE1に、検索結果はK1に表示するようにするにはどのようにしたらいいでしょうか？ Sub FIND_DATA1() ' FIND_DATA1 Macro ' マクロ記録日 : 2006/9/1 ユーザー名 : ' Cells.Find(What:=Range("E1").Value, After:=ActiveCell, lookAt:=xlWhole).Activate End Sub Sub Data_Find3() Dim 対象セル As Range Dim 最初のセル番地 As String Dim 検索件数 As Long Cells.Interior.ColorIndex = xlNone If Range("E1").Value = "" Then Exit Sub End If Set 対象セル = Cells.Find(What:=Range("E1").Value, After:=ActiveCell, lookAt:=xlWhole) 最初のセル番地 = 対象セル.Address Do 対象セル.Interior.ColorIndex = 37 検索件数 = 検索件数 + 1 Set 対象セル = Cells.FindNext(対象セル) Loop While 対象セル.Address <> 最初のセル番地 MsgBox "検索件数は" & 検索件数 - 1 & " 件です" End Sub 本を見たり調べたりでここまでできたんですがこれだと検索件数、検索結果が色付きになるだけで使い勝手がいまいちです。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- 検索後、行を抽出するマクロ 2
はじめまして マクロ初心者です、自分で出来ませんのでやりたいことに合うマクロをネットで探してやっておりますが、どうにもなりませんどなたかご教授お願いします。 下記のマクロで結果はOKなのですが、インプットボックスでは無く特定のセル（”A1”）の値から検索したいのです、また、結果の出る("Sheet2") を1回全てクリアにしてから結果が出る様にしたいのですが、どなたかご教授お願いします。 >Sub test01() >Dim ws1 As Worksheet, ws2 As Worksheet >Dim rng As Range Dim myStr, ra, rr myStr = InputBox("検索する文字", " (´^∇^)σ 入力してください", "") If myStr = "" Then MsgBox "検索文字未指定", vbCritical, " Σ（￣ロ￣lll)" Exit Sub End If Set ws1 = Sheets("Sheet1") '検索 シート Set ws2 = Sheets("Sheet2") '貼付先シート With ws1.Columns("A") '部分一致で検索（A列） Set rng = .Find(What:=myStr, LookAt:=xlPart, After:=.Cells(.Cells.Count)) If rng Is Nothing Then 'なかったら MsgBox "ありません", vbCritical, myStr & "？ (￣～￣;)う～ん " Else 'あったら ra = rng.Address '最初に見つかったセルアドレス Do rr = rr + 1 'カウント rng.EntireRow.Copy Destination:=ws2.Cells(rr, 1) '行のコピペ Set rng = .FindNext(rng) '連続検索 Loop While rng.Address <> ra '繰り返し Set rng = Nothing End If End With MsgBox rr & "件をSheet2に抽出しました。", vbInformation, " （￣ー￣）v" Set ws1 = Nothing Set ws2 = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- マクロで入力済の最初のセルを取得したい
マクロはまったくの初心者なのですが、シートに入力されている最初のセルを取得（行と列の番号）したいと思って下記の通りやってみたのですがうまくいきません。 Gyou = 1 Retu = 1 Chek1: Maxcol = Cells(Gyou,Retu).End(xlToRight).Column If MaxCol <> 0 then GoTo Chek2 End If If Gyou < 65536 then Gyou = Gyou + 1 GoTo Chek1 End If Chek2: MsgBox Maxcol としたのですが、入力されているセルはＢ３、Ｃ５だけです。 結果、MsgBox に表示されたのは２５６でした。 一番最初に入力されているセルはＢ３なのでMsgBoXには２と表示されると思ったのですがだめでした。 どこがおかしいのか自分では全然わかりません。あと、一番最初に入力されているセルの行番号も取得したいのですが、どなたかお教え下さい。よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- セルの値からマクロで検索を行うには
エクセルのシート１枚に７００件程の物品の在庫管理をしています。 件数が多いためナンバーで検索を行えるよう、以下のようなマクロを作ってみました。 Sub 検索を行う() Dim 検索セル As Range Set 検索セル = Range("A1:A675").Find(120) If Not 検索セル Is Nothing Then 検索セル.Activate End If End Sub これでＡ列の「１２０番」を検索できるのですが、セルに入力した数値を検索するには、どうすればよいのでしょうか？？ （例えばセルE1に１２０と入力して検索） 色々調べてみたのですが、セルの値から検索ができなくて・・・・。 よろしくご教授ください。
- ベストアンサー
- オフィス系ソフト
- Excelで検索結果表示の修正
下記のマクロでA列だけ検索できるようにしたいのですが、どこを修正したらいいのか教えてください。 Private Sub CommandButton1_Click() AAA End Sub Sub AAA() strMoji$ = UserForm1.TextBox1.Text If UserForm1.TextBox1.Text = "" Then MsgBox "検索条件を入力してください。", 48 Exit Sub End If On Error GoTo Fail Cells.Find(What:=strMoji, After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ ).Activate lonNUM& = Selection.Row UserForm1.TextBox2.Text = Cells(lonNUM, 2).Value UserForm1.TextBox3.Text = Cells(lonNUM, 3).Value Exit Sub Fail: MsgBox "該当なし", 48 End Sub Private Sub UserForm_Click() End Sub
- ベストアンサー
- オフィス系ソフト
- マクロ 検索できなかった検索値を表示したい
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
- ベストアンサー
- オフィス系ソフト
お礼
早速のご回答 ありがとうございます。 おかげさまで したかったことが できるようになりました。 ほんとうに助かりました。 また何かありましたら よろしくお願いいたします。