VBAで検索をかけその結果の表示をコントロールする方法

VBAでマクロを組んでいます。
セルに検索をかけヒットする行のみ表示する方法をご教示ください。

No.2 回答者： 1050YEN 回答日時： 2010/02/05 11:35

2部構成

その2

'検索結果を表示状態で反映する関数
Private Sub ChgSarchVisible(p_xlsSheet As Excel.Worksheet, p_lstSerch As Collection)
　　Dim i　　　　　 As Long
　　Dim l_lngHitRow As Long
　　Dim l_lngBefRow As Long
　　Dim l_rngArea　 As Excel.Range
　　
　　'一旦全部見せる
　　Call RowsVisible(p_xlsSheet.Cells, True)
　　
　　For i = 1 To p_lstSerch.Count
　　　　l_lngHitRow = p_lstSerch.Item(i)
　　　　
　　　　'最後の時だけの処理
　　　　If (i = p_lstSerch.Count) Then
　　　　　　'最終行では無いとき
　　　　　　If (l_lngHitRow < DEF_MAX_ROW) Then
　　　　　　　　'最後の結果以降も非表示
　　　　　　　　Set l_rngArea = GetRowsArea(p_xlsSheet, l_lngHitRow + 1, DEF_MAX_ROW)
　　　　　　　　Call RowsVisible(l_rngArea, False)
　　　　　　End If
　　　　End If
　　　　
　　　　'連続して見つかっている場合は、処理を行わない
　　　　If (l_lngHitRow = l_lngBefRow + 1) Then
　　　　　　GoTo CONTINUE
　　　　End If
　　　　
　　　　Set l_rngArea = GetRowsArea(p_xlsSheet, l_lngBefRow + 1, l_lngHitRow - 1)
　　　　Call RowsVisible(l_rngArea, False)
　　　　
CONTINUE:
　　　　l_lngBefRow = l_lngHitRow
　　Next i
End Sub

'開始行～終了行のエリアを取得
Private Function GetRowsArea(p_xlsSheet As Excel.Worksheet, p_lngRow1 As Long, p_lngRow2 As Long) As Range
　　Set GetRowsArea = p_xlsSheet.Rows(p_lngRow1 & ":" & p_lngRow2)
End Function

'行エリアの表示状態を設定
Private Sub RowsVisible(p_rngArea As Excel.Range, p_blnVisible As Boolean)
　　p_rngArea.EntireRow.Hidden = Not p_blnVisible
End Sub

No.1 回答者： 1050YEN 回答日時： 2010/02/05 11:27

2部構成

その1

Option Explicit

Private Const DEF_MAX_COL　　　 As Long = &H100&
Private Const DEF_MAX_ROW　　　 As Long = &H10000

Private Sub Main()
　　Dim l_xlsBook　 As Excel.Workbook
　　Dim l_xlsSheet　As Excel.Worksheet
　　Dim l_lstSerch　As Collection
　　Dim l_strSerch　As String
　　
　　l_strSerch = InputBox("入力してください", "検索文字列を入力", "aaa")
　　If (Len(l_strSerch) = 0) Then
　　　　Exit Sub
　　End If
　　
　　'対象ブック(前面に存在するブック)
　　Set l_xlsBook = Application.ActiveWorkbook
　　'そのカレントのシート
　　Set l_xlsSheet = l_xlsBook.ActiveSheet
　　
　　'検索結果を取得
　　Set l_lstSerch = GetFindRows(l_xlsSheet, l_strSerch)
　　If (l_lstSerch.Count = 0) Then
　　　　MsgBox "検索結果なし"
　　　　Exit Sub
　　End If
　　
　　'検索結果を反映
　　Call ChgSarchVisible(l_xlsSheet, l_lstSerch)
End Sub

'検索で見つかった行番号(ROW)を返却する関数
Private Function GetFindRows(p_xlsSheet As Excel.Worksheet, p_strFindString As String) As Collection
　　Dim l_lstRet　　As Collection
　　Set l_lstRet = New Collection
　　
　　Dim l_blnExists As Boolean
　　
　　Dim l_rngLast　 As Excel.Range
　　Dim l_rngSarch　As Excel.Range

　　'最終CELLを取得
　　Set l_rngLast = p_xlsSheet.Cells(DEF_MAX_ROW, DEF_MAX_COL)
　　
　　'先頭から検索（検索引数は自分でカスタマイズ）
　　Set l_rngSarch = p_xlsSheet.Cells.Find(p_strFindString, After:=l_rngLast, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
　　
　　Do
　　　　If l_rngSarch Is Nothing Then
　　　　　　Exit Do
　　　　End If
　　　　
　　　　'見つかったアイテムの行番号を記憶
　　　　On Error Resume Next
　　　　Call l_lstRet.Add(l_rngSarch.Row, CStr(l_rngSarch.Row))
　　　　l_blnExists = Not (Err.Number = 0&)
　　　　On Error GoTo 0
　　　　
　　　　'既に登録済みならループ抜け
　　　　If l_blnExists Then
　　　　　　Exit Do
　　　　End If
　　　　
　　　　'見つかった行番号の最終列以降から続けて検索
　　　　Set l_rngLast = p_xlsSheet.Cells(l_rngSarch.Row, DEF_MAX_COL)
　　　　Set l_rngSarch = p_xlsSheet.Cells.FindNext(l_rngLast)
　　Loop
　　
　　Set GetFindRows = l_lstRet
End Function