複数ファイルシート一括検索(下階層対応版)

Pocket

以前、「複数ファイルシート一括検索」という記事を書きました。複数のExcelファイルの全てのシートを対象として文字列検索をするマクロです。
フォルダ内の全てのファイルを対象としますが下の階層のフォルダには対応していませんでした。
今回、下の階層を含めて検索するように改良しました。

コードは四つあります。一枚のモジュールに貼り付けてください。

宣言

Option Explicit
Const result_sheet = "検索結果"
Dim all_files(9999, 1) As String
Dim last_index As Long
Dim my_row As Long

まずモジュールレベル定数を宣言しています。「検索結果」という名前の空のシートを準備してください。ここに結果を表示します。
またモジュールレベル変数を三つ宣言しています。

ファイル名を取得する

Function get_files(my_path)
    '指定したフォルダにある全てのファイル名(パス付)を取得する。
    Dim this_file(999) As String
    Dim this_path As String
    Dim i As Long
    Dim j As Long
    this_file(0) = Dir(my_path, vbDirectory)
    i = 0
    Do
        i = i + 1
        this_file(i) = Dir
    Loop Until this_file(i) = ""
    For j = 0 To i - 1
        If this_file(j) <> "." And this_file(j) <> ".." Then
            this_path = my_path & this_file(j)
            If GetAttr(this_path) = vbDirectory Then
                Call get_files(this_path & "")
            Else
                all_files(last_index, 0) = this_file(j)
                all_files(last_index, 1) = my_path
                last_index = last_index + 1
            End If
        End If
    Next j
End Function

ファイルを取得し配列変数all_filesにセットします。フォルダの場合は再帰的にその中のファイルを取得します。

メイン

Sub 複数ファイルシート一括検索()
    Dim my_path As String
    Dim my_file As String
    Dim search As String
    Dim i As Long
    Erase all_files
    last_index = 0
    my_row = 2
    search = InputBox("検索文字列を入力")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択"
        .AllowMultiSelect = False
        If .Show = -1 Then
            my_path = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    Call get_files(my_path & "")
    Sheets(result_sheet).Select
    Cells.ClearContents
    Range("A1:E1").Value = Array("Folder", "File", "Sheet", "Value", "Link")
    i = 0
    Do
        If InStr(all_files(i, 0), ".xls") > 0 Then
            Call ファイルを検索(all_files(i, 1), all_files(i, 0), search)
        End If
        i = i + 1
    Loop Until all_files(i, 0) = ""
    Sheets(result_sheet).Select
End Sub

検索文字列とフォルダを指定します。対象となる全てのファイル、シートを取得し検索します。

検索・編集

Function ファイルを検索(my_path, my_file, search)
    Dim my_sheet
    Dim kekka
    Dim base_fn As String
    Dim my_sn As String
    Dim my_address As String
    Dim first_address As String
    base_fn = ThisWorkbook.Name
    Workbooks.Open Filename:=my_path & my_file
    For Each my_sheet In Worksheets
        my_sn = my_sheet.Name
        Set kekka = my_sheet.Cells.Find(search)
        If Not kekka Is Nothing Then
            first_address = kekka.Address
            Do
                my_address = my_path & "" & my_file & "#" & my_sn & "!" & kekka.Address
                With Workbooks(base_fn).Sheets(result_sheet)
                    .Cells(my_row, 1) = my_path
                    .Cells(my_row, 2) = my_file
                    .Cells(my_row, 3) = my_sn
                    .Cells(my_row, 4) = kekka.Value
                    .Hyperlinks.Add Anchor:=.Range("E" & my_row), _
                        Address:=my_address, _
                        TextToDisplay:=kekka.Address
                End With
                my_row = my_row + 1
                Set kekka = my_sheet.Cells.FindNext(kekka)
            Loop While Not kekka Is Nothing And kekka.Address <> first_address
        End If
    Next
    Workbooks(my_file).Close
End Function

指定したファイルの全てのシートについて、文字列を検索します。
検索結果を「検索結果」シートにセットします。
該当のセルにハイパーリンクを張るようになっています。

関連記事

[ 2015年5月22日 | カテゴリー: Excel | タグ: , , ]

« | »

コメント

  1. えるさ より:

    先日は回答ありがとうございます!
    マクロ初心者です。
    早速このマクロ使わせていただきました!
    しかし、実行時エラー91がでて、
    オブジェクト変数または、Withブロック変数
    が設定されていません。と、
    でて、
    Loop While Not kekka Is Nothing And kekka.Address first_address
    でエラーがでます。
    なにがだめなのでしょう?

  2. stabucky より:

    >えるささん
    ちょっと調べましたが原因が分かりませんでした。
    申し訳ありません。

  3. えるさ より:

    シートが30毎くらいあって、
    一個めには、ヒットするんですが
    二個目が検索できずエラーがでます。
    ありがとうございました(;_;)

  4. てつや より:

    マクロ利用させて頂いてます。
    正常に稼働し、いままで時間がかかっていた
    ことが瞬時に出来て泣きそうです。

    質問ですが、

    検索にヒットしたセルが「N4」だった場合

    「N4」と同じ行である
    「A4」「B4」「C4」「D4」「E4」「L4」「M4」
    のセル内容を、検索結果シートの「F列」以降に
    表示させるにはどうしたら良いですか。

    ハイパーリンクで該当セルまで行かずに、
    検索結果の表の中で見たい情報を網羅
    したいと考えてます。

    お手数かと思いますが、よろしくお願い致します。

  5. stabucky より:

    >てつやさん
    ご利用ありがとうございます。
    質問いただいた件ですが、難しいです。
    発見したセルだけでなく、その周辺のセルの情報を取得することになるので、ちょっと修正するだけでは済まないような気がします。
    申し訳ありません。

  6. てつや より:

    了解しました。
    大変失礼しました。

    頑張ってマクロの学習します!

    また教えて下さい。

  7. stabucky より:

    >てつやさん
    こちらこそよろしくおねがいします。

  8. misson より:

    Loop Whileのところでエラーがでるのは
    シート内で結合セルのみがヒットすると
    FindNextの結果がNothingになるからみたいですね

  9. stabucky より:

    >missonさん
    セルの結合は自分自身はなるべく使わないようにしているので想定していませんでした。
    ありがとうございました。

  10. ぶん より:

    こちらでもすいません。当方は複数のドライブがある環境で、Bフォルダ(Aドライブ内にあります)を検索したいのですが、Bフォルダを指定しても「ファイルがみつかりません」となります。一方で、Aドライブを指定した場合、Aドライブ直下にあるエクセルは検索できます。何が原因か分からず、苦労しております。ぜひご指導頂きますと有難いです。

  11. ぶん より:

    出来れば、フォルダ指定なく、指定のドライブ→フォルダを特定し、検索をかけたいのです。大変わがままな相談ですが、ぜひご指導くださいませ。

  12. stabucky より:

    >ぶんさん
    複数ドライブの件は、少し考えましたが思いつきませんでした。
    フォルダ指定の件は、フォルダを固定するということであれば
    複数ファイルシート一括検索()の
    With〜End With の箇所を削除し、代わりに
    my_path=指定のフォルダ
    のように書けばいいと思います。
    お役に立てず申し訳ありません。

  13. ぶん より:

    ありがとうございます!
    早速試してみます

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

送信してください。


タグ

カテゴリー

最近の投稿

最近のコメント

固定ページ

アーカイブ

stabucky

写真

メタ情報