トップ > 汎用コード > 指定フォルダの全ブック対象に一括検索

  このエントリーをはてなブックマークに追加  

指定フォルダの全ブック対象に一括検索

指定フォルダの全ブック・全シートを対象に、任意の文字列を一括検索するマクロです。

マクロを実行すると、フォルダ参照ダイアログが表示されます。
フォルダを選択すると、そのフォルダ内の、全てのExcelブックの全シートを対象に、検索を開始します。
検索の結果は、新しいブックにまとめて出力されます(下図参照)。



検索する文字列は、複数の指定が可能です。

コードの貼り付け場所

サンプルコード

'///宣言セクション///
Dim myWB As Workbook
Dim varArray As Variant
'///

Sub All_Books_FIND() 'メイン varArray = Array("富山", "神奈川") '検索文字列 Dim strDirPath As String 'フォルダの選択 With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then strDirPath = .SelectedItems(1) End With If Len(strDirPath) = 0 Then Exit Sub 'フォルダの存在確認 If Dir(strDirPath, vbDirectory) = "" Then Exit Sub 'フォルダ内ブック検索処理 Call Search_Books_f(strDirPath) End Sub
Private Sub Search_Books_f(ByVal strPath As String) 'フォルダ内ブック検索 Dim strTarget As String, strDirPath As String With Application strPath = strPath & .PathSeparator 'フォルダパスにフォルダ区切り文字追加 strTarget = Dir(strPath & "*.xls?") 'フォルダ内のExcelブックを検索 If strTarget = "" Then Exit Sub 'ブックがなければ終了 .ScreenUpdating = False '画面更新停止 .DisplayAlerts = False '確認メッセージ非表示 Call Add_myBook '書き込み用ブック作成 On Error Resume Next Do Call Books_Find_Main(.Workbooks.Open(strPath & strTarget)) 'ブックを開き置換処理 strTarget = Dir() '次のExcelブックを検索 Loop Until strTarget = "" 'ブックがなければループから抜ける On Error GoTo 0 .DisplayAlerts = True .ScreenUpdating = True End With strTarget = Dir("") myWB.Worksheets(1).Columns("A:C").AutoFit Set myWB = Nothing End Sub
Private Sub Add_myBook() Set myWB = Workbooks.Add With myWB.Worksheets(1) .Cells(1, 1).Value = "検索文字列:" & Join$(varArray, ",") .Cells(2, 1).Value = "ブック名" .Cells(2, 2).Value = "シート名" .Cells(2, 3).Value = "セルアドレス" End With End Sub
Private Sub Books_Find_Main(WB As Workbook) 'ブック内全シートの検索 Dim v As Variant, strAddress As String Dim Sh As Worksheet, rngFnd As Range, rngUni As Range With WB .Activate For Each Sh In .Worksheets For Each v In varArray Set rngFnd = Sh.Cells.Find(What:=v, LookAt:=xlPart) '検索 If Not rngFnd Is Nothing Then strAddress = rngFnd.Address '最初に検索一致したセルのアドレス格納 If rngUni Is Nothing Then Set rngUni = rngFnd Do Set rngUni = Union(rngUni, rngFnd) 'セルを集合 Set rngFnd = Sh.Cells.FindNext(rngFnd) '次を検索 Loop Until strAddress = rngFnd.Address End If Next If Not rngUni Is Nothing Then With myWB.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1) .Value = WB.Name .Offset(, 1).Value = Sh.Name .Offset(, 2).Value = rngUni.Address(False, False) End With Set rngUni = Nothing End If Next .Close End With End Sub

「検索文字列」
 検索する文字列です。検索文字列の追加は、次の例を参考にしてください。
 例:Array("富山", "神奈川") → Array("富山", "神奈川", "千葉", "埼玉")

「LookAt:=xlPart
 検索文字列が、セル内のデータに含まれる場合も一致判定となります。
 【例】検索文字列:りんご セル内データ:青りんご → 一致判定
 セルと完全一致のみを一致とする場合:xlPart → xlWhole

ページトップへ戻る

Excel 汎用コード

Word 汎用コード

Copyright(C) 2009- 坂江 保 All Rights Reserved.