ブック全体の検索の次へは？

質問

ブック全体を検索するマクロ作ったのですが、
ブックの最初にあるものしか見つけられません。
見つかった時に、次の検索を行うにはどのようなＶＢＡになるのでしょうか？
よろしくお願いもうしあげます。

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

回答No.2

Wendy02 · ベストアンサー

こんにちは。

気に入るかどうかは分かりませんが、
一旦、InputBox で立ち上げて検索して発見した後は、マクロは一旦、とまってしまいます。
ですから、ショートカットを設けました。

SetKey を実行してください。
KensakuAll
[Ctrl + Shift + F ]
FindActivate
[Ctrl + Shift + H ]
で、続行してください。

'標準モジュールです。

Dim Ar1() As Variant 'モジュールの一番上に書き出す
Dim Ar2() As Variant
Dim cnt As Integer
Sub KensakuAll()
Dim Key1 As String
Dim c As Range
Dim FirstAdd As String
Dim ShName As String
Dim i As Long
Dim j As Long
Erase Ar1()
Erase Ar2()
cnt = 0
Key1 = InputBox("検索キーを入力しなさい")
If Key1 = "" Then Exit Sub

For i = 1 To ActiveWorkbook.Worksheets.Count
　　Set c = Worksheets(i).Cells.Find( _
　　 What:=Key1, _
　　 LookIn:=xlValues, _
　　 LookAt:=xlWhole, _
　　 SearchOrder:=xlByRows)
　　　　 If Not c Is Nothing Then
　　　　　FirstAdd = c.Address
　　　　　ReDim Preserve Ar1(j)
　　　　　ReDim Preserve Ar2(j)
　　　　　Ar1(j) = c.Address
　　　　　Ar2(j) = Worksheets(i).Name
　　　　　j = j + 1

　　　　　　Do
　　　　　　Set c = Worksheets(i).Cells.FindNext(c)
　　　　　　If c.Address = FirstAdd Then Exit Do
　　　　　　If Not c Is Nothing Then
　　　　　　　　ReDim Preserve Ar1(j)
　　　　　　　　ReDim Preserve Ar2(j)
　　　　　　　　Ar1(j) = c.Address
　　　　　　　　Ar2(j) = Worksheets(i).Name
　　　　　　　　j = j + 1
　　　　　　End If
　　　　　Loop Until c Is Nothing
　　　　 End If
　　　　 FirstAdd = ""
　　　　Next
　　Call FindsActivate
End Sub
Sub FindsActivate()
Dim a As String
On Error Resume Next
a = Ar1(0)
If Err.Number > 0 Then
　MsgBox "検索値はありません。", vbInformation
　Exit Sub
End If
On Error GoTo 0
Application.Goto Worksheets(Ar2(cnt)).Range(Ar1(cnt))
cnt = cnt + 1
If cnt > UBound(Ar1) Then
　 cnt = 0
End If
End Sub

'--------------------------------------
Sub SetKey()
　'KensakuAll.. ショートカット [Ctrl + Shift + F ]
　Application.OnKey "+^F", "KensakuAll" 'Ctrl + Shift + F
　'FindActivate..ショートカット [Ctrl + Shift + H ]
　Application.OnKey "+^H", "FindsActivate" 'Ctrl + Shift + H
End Sub

'--------------------------------------

お礼

回答ありがとうございます。
最初にすべて検索してしまう方法、コロンブスの卵のような方法があったんですね。
それとモジュールの一番上にDIMを書き出すのができるのも知りませんでした。
PrivateかPublicをつけなければいけないと思っていました。

回答No.3

Wendy02

補足ですが、

Excel2000～2003 なら、二つボタンが必要になりますが、ツールバーにツールボタンやコマンドボタンを置いてもよいです。

ショートカットを付けたのは、やはり、バージョンの問題があったので考えました。もちろん、2007 でも可能ですが、若干、ボタンのデザインや操作性が落ちます。

>最初にすべて検索してしまう方法、
それは、ご質問のコードのスタイルから考えたのです。

それと、Dim をモジュールレベルにした理由は、「標準モジュール」とは書いたものの、開発の最初には、コントロールツールのボタンに置いていたからです。言い換えると、シートモジュールでも可能ですが、シートをまたいでいくので、その後が続きません。正式には、たいした理由ではないのですが、Dimは、Private にするべきかと思います。

回答No.1

hana-hana3

FindNext
http://search.goo.ne.jp/web.jsp?status=select&from=goo_oshiete&PT=goo_oshiete&nsMT=&MT=vba+findnext&c=0