[[20120306165824]]　『検索結果数を表示』（とろい）　ページの最後に飛ぶ

『検索結果数を表示』（とろい）

 全シートから文字検索するのですが、検索結果のヒット数を
 最後に表示するにはどうすれば良いですか？

 Sub find_main()
     'Call find_pro(True) '全シート検索
     Call find_pro(False) '全シート検索
 End Sub

 '全シート検索
 Sub find_pro(all_f As Boolean)
     Dim sh As Worksheet
     Dim s As String
     Dim hit_f As Boolean
     hit_f = False
     s = InputBox("検索文字列＝")
     If s = "" Then Exit Sub
     For Each sh In ActiveWorkbook.Worksheets
         If all_f = True Then
             Set x = sh.Cells.Find(what:=s, LookAt:=xlWhole) '全てが一致
             Else
             Set x = sh.Cells.Find(what:=s, LookAt:=xlPart) '一部が一致
         End If
         If x Is Nothing Then GoTo p1
         hit_f = True
         b = sh.Name & x.Address
         sh.Activate
         x.Select
         If MsgBox(sh.Name & "　" & x.Address & "  処理を続行します！", _
             vbQuestion + vbOKCancel + vbDefaultButton2, "確認") = vbCancel Then Exit Sub
         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.Select
             If MsgBox(sh.Name & "　" & y.Address & "  処理を続行します！", _
                 vbQuestion + vbOKCancel + vbDefaultButton2, "確認") = vbCancel Then Exit Sub
         Loop
 p1:
     Next
     If hit_f = True Then
         MsgBox "検索終了しました。"
     Else
         MsgBox "みつかりませんでした。"
     End If
 End Sub

 Findメソッドを使った複数検索のロジックって結構面倒です。

 find_proというプロシジャーは、とろいさんが作成されたのですよね？
 だとしたら、検索数をカウントするのは、このfind_proを作成された方にとって
 それほど、難しいことではありません。

 もし、find_proというプロシジャーは、とろいさんが作成されたのではないなら、
 提示されたコードを御自分で解析してください。
 その上で理解できない箇所を特定して　質問してください。

 御自分で作成したなら、言わずもがなですが、

 Findメソッドを使って最初に検索されたセルアドレスを覚えておいて、
 Findnextメソッドを使って、再度、覚えておいたセルアドレスを検出するまで
 Findnextメソッドのループを行う　というのが概略ロジックです。

 拝見したコードも概ねそのようになっているのだと思います。

 これがわかれば、カウントするコードをどこに入れればよいかは、
 わかると思います。

 ichinose

 すみません、私が作った物ではありません。
 教えてもらい、しらべてみたのですが、
 出来たようにおもいます。ありがとうございました。

 Sub find_main()
     'Call find_pro(True) '全シート検索
     Call find_pro(False) '全シート検索
 End Sub

 '全シート検索
 Sub find_pro(all_f As Boolean)
     Dim sh As Worksheet
     Dim s As String
     Dim hit_f As Boolean
     Dim hit_n As Double
     hit_f = False
     s = InputBox("検索文字列＝")
     If s = "" Then Exit Sub
     For Each sh In ActiveWorkbook.Worksheets
         If all_f = True Then
             Set x = sh.Cells.Find(what:=s, LookAt:=xlWhole) '全てが一致
             Else
             Set x = sh.Cells.Find(what:=s, LookAt:=xlPart) '一部が一致
         End If
         If x Is Nothing Then GoTo p1
         hit_f = True
         b = sh.Name & x.Address
         sh.Activate
         x.Select
         If MsgBox(sh.Name & "　" & x.Address & "  処理を続行します！", _
             vbQuestion + vbOKCancel + vbDefaultButton2, "確認") = vbCancel Then Exit Sub
         Do
             Set y = sh.Cells.FindNext(after:=ActiveCell)
             If y Is Nothing Then GoTo p1
             hit_n = hit_n + 1
             If sh.Name & y.Address = b Then GoTo p1
             y.Select
             If MsgBox(sh.Name & "　" & y.Address & "  処理を続行します！", _
                 vbQuestion + vbOKCancel + vbDefaultButton2, "確認") = vbCancel Then Exit Sub
         Loop
 p1:
     Next
     If hit_f = True Then
         MsgBox hit_n & " 個みつかりました。"
     Else
         MsgBox "みつかりませんでした。"
     End If
 End Sub

 私は、もう10年ぐらい仕事では、Findメソッドというコードを直接記述したことがありません。
 >Findメソッドを使って最初に検索されたセルアドレスを覚えておいて、
 >Findnextメソッドを使って、再度、覚えておいたセルアドレスを検出するまで
 >Findnextメソッドのループを行う　というのが概略ロジックです。

 このロジックを毎回記述するのが嫌で嫌で・・・。

 私がこれを作るなら、こうなります。

 標準モジュールに

 '=========================================================
 Sub 全シート文字列検索()
    Dim fstr As Variant
    Dim sht As Worksheet
    Dim f_cnt As Long
    Dim frng As Range
    fstr = Application.InputBox("検索する文字列入力してください", "文字列検索")
    If TypeName(fstr) <> "Boolean" Then
       For Each sht In ActiveWorkbook.Worksheets
           sht.Select
           Set frng = get_findcell(fstr, sht.Cells, , xlValues, xlPart, xlByRows, xlNext, True)
           Do Until frng Is Nothing
              f_cnt = f_cnt + 1
              frng.Select
              If MsgBox(frng.Address(, , , True) & "  処理を続行します！", _
             vbQuestion + vbOKCancel + vbDefaultButton2, "確認") = vbCancel Then Exit For
             Set frng = get_findcell
          Loop
       Next
       MsgBox fstr & "  を  " & f_cnt & "回確認しました"
    End If
 End Sub

 別の標準モジュールに初版は10年前のFind専用プロシジャー

 '================================================================
 Option Explicit
 Function get_findcell(Optional ByVal f_v As Variant = "", _
                      Optional ByVal rng As Range = Nothing, _
                      Optional ByVal strng As Range = Nothing, _
                      Optional ByVal alookin As XlFindLookIn = -4163, _
                      Optional ByVal alookat As XlLookAt = 1, _
                      Optional ByVal aso As XlSearchOrder = 1, _
                      Optional ByVal asd As XlSearchDirection = 1, _
                      Optional ByVal mc As Boolean = False, _
                      Optional ByVal mb As Boolean = True) As Range
 '指定された値でセル範囲を検索し､該当するセルを取得する
 'input : f_v 検索する値
 '　　　　rng 検索する範囲
 '       strng 検索開始するセル（実際には、このセルの次から検索する）
 '　　　　alookin 検索対象　xlvalues,xlformulas,xlcomments
 '　　　　alookat: :検索方法 1-完全一致　2-部分一致
 '　　　　aso　: 検索順序　1 行　2　列
 '　　　　asd　: 検索方向　1　Xlnext　2　XlPrevious
 '　　　　mc　 : 大文字・小文字の区別　False　しない　True　する
 '　　　　mb　 : 半角と全角を区別　　 True　する　　False　しない
 'output:get_findcell 見つかったセル(見つからなかったときはNothingが返る)
    Static 検索範囲 As Range
    Static 最初に見つかったセル As Range
    Static 直前に見つかったセル As Range
    Static 検索方向 As XlSearchDirection
    Dim app As Object
    If Not rng Is Nothing Then
       If Val(Application.Version) > 9 Then
          Set app = Application
          app.FindFormat.Clear
          Set app = Nothing
       End If
       Set 検索範囲 = rng
       検索範囲.Parent.Columns(1).Find ""
       If strng Is Nothing Then
          If asd = 1 Then
             Set strng = 検索範囲.Cells(検索範囲.Rows.Count, 検索範囲.Columns.Count)
          Else
             Set strng = 検索範囲.Cells(1, 1)
          End If

       End If
    End If
    If f_v <> "" Then

       Set get_findcell = 検索範囲.Find(f_v, strng, alookin, alookat, aso, asd, mc, mb)
       If Not get_findcell Is Nothing Then
          Set 最初に見つかったセル = get_findcell
          Set 直前に見つかったセル = get_findcell
          検索方向 = asd
       End If
    Else
       If 検索方向 = xlNext Then
          Set get_findcell = 検索範囲.FindNext(直前に見つかったセル)
       Else
          Set get_findcell = 検索範囲.FindPrevious(直前に見つかったセル)
       End If
       If Not get_findcell Is Nothing Then
          If get_findcell.Address = 最初に見つかったセル.Address Then
             Set get_findcell = Nothing
          Else
             Set 直前に見つかったセル = get_findcell
          End If
       End If
    End If
 End Function

 これで　全シート文字列検索を実行してみてください。
 投稿されたコードと概ね同じ時動作をします。

 ichinoseさん大変有り難う御座いました。
 完全・部分一致　大・小区別とかも全て揃っていて
 素晴らしいです。（とろい）

コメント返信：

[ 一覧(最新更新順) ]

[[20120306165824]] 『検索結果数を表示』（とろい） ページの最後に飛ぶ

[[20120306165824]]　『検索結果数を表示』（とろい）　ページの最後に飛ぶ