複数ファイルシート一括検索

Pocket

Windowsにはファイルの内容を検索する機能があります。
しかしExcelを検索する場合、どのファイルにあるかは表示されますが、どのシートにあるかは表示されません。
シートが多いと、そのファイルを開いてから、また検索する必要があります。

そこで、ある文字列について、特定のフォルダにある、すべてのExcelファイルのすべてのシートを検索し、どのシートにあるかを表示するマクロを考えました。
検索結果を表示するだけでなく、該当のセルにハイパーリンクを張るようになっています。
Excel2007で確認しました。

  1. 適当なExcelファイルを用意します。
  2. シートの名前を「検索結果」とします。ここに検索結果が表示されます。
  3. 下に書かれているコード(3つの部分)を標準モジュールに貼り付けます(3つまとめて)。
  4. マクロ「複数ファイルシート一括検索」を実行します。
  5. 検索したい文字列を入力します。
  6. 検索したいフォルダを指定します。
  7. 検索結果(ファイル名、シート名、セルの内容、リンク)が表示されます。
  8. 「$A$1」という表示はセルを表し、リンクが張られています。クリックすると該当のファイルを開きジャンプします。

2015年5月22日追記
下階層(フォルダ内のフォルダ)に対応した版を作りました。「複数ファイルシート一括検索(下階層対応版)」

宣言

Const resultsn = "検索結果"
Dim gyo As Long

モジュールの先頭に書きます。

メイン

Sub 複数ファイルシート一括検索()
    Dim myfolder, myfn, myword
    myword = InputBox("検索文字列を入力")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択"
        .AllowMultiSelect = False
        If .Show = -1 Then
            myfolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    myfn = Dir(myfolder & "\*.xls", vbNormal)
    Sheets(resultsn).Select
    Cells.ClearContents
    Cells(1, 1) = "ファイル名"
    Cells(1, 2) = "シート名"
    Cells(1, 3) = "セルの内容"
    Cells(1, 4) = "リンク"
    gyo = 2
    Do Until myfn = ""
        Call ファイルを検索(myfolder, myfn, myword)
        myfn = Dir
    Loop
    Sheets(resultsn).Select
End Sub

フォルダの中のファイルを取得して、それぞれ処理します。

検索・編集

Function ファイルを検索(myfolder, myfn, myword)
    Dim mysheet
    Dim basefn, mysn, myaddress
    Dim kekka
    Dim firstaddress
    basefn = ThisWorkbook.Name
    Workbooks.Open Filename:=myfn
    For Each mysheet In Worksheets
        mysn = mysheet.Name
        Set kekka = mysheet.Cells.Find(myword)
        If Not kekka Is Nothing Then
            firstaddress = kekka.Address
            Do
                myaddress = myfolder & "\" & myfn & "#" & mysn & "!" & kekka.Address
                With Workbooks(basefn).Sheets(resultsn)
                    .Cells(gyo, 1) = myfn
                    .Cells(gyo, 2) = mysn
                    .Cells(gyo, 3) = kekka.Value
                    .Hyperlinks.Add Anchor:=.Range("D" & gyo), _
                        Address:=myaddress, _
                        TextToDisplay:=kekka.Address
                End With
                gyo = gyo + 1
                Set kekka = mysheet.Cells.FindNext(kekka)
            Loop While Not kekka Is Nothing And kekka.Address <> firstaddress
        End If
    Next
    Workbooks(myfn).Close
End Function

取得したファイルに対して検索を実行し見付かった場合にはシートに書き出します。
シートを検索する手法とハイパーリンクを張る手法が使われています。

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

« | »

コメント

  1. くまさん より:

    マクロ初心者です。
    一つ筆問なんですが、下層フォルダーまでは検索できない仕様なのでしょうか?

  2. stabucky より:

    下位のフォルダは検索できません。
    手法はありますが、簡単には修正できそうにありません。
    申し訳ありません。

  3. abc より:

    マクロ初心者です。
    スクリプト実行してみました。すごいですね。
    リンクのセルをなくす場合は、下記をコメントか削除すればよいのでしょうか。

    ご教授ください。

    ‘Cells(1, 4) = “リンク”
    .’Hyperlinks.Add Anchor:=.Range(“D” & gyo), Address:=myadress, TextToDisplay:=kekka.Address

  4. stabucky より:

    abcさん
    ご利用ありがとうございます。
    お書きになった通り次の部分をコメントアウトすればリンクは作られないはずです。

    メインの部分
    ‘Cells(1, 4) = “リンク”

    検索・編集の部分
    ‘.Hyperlinks.Add Anchor:=.Range(“D” & gyo), _
    ‘Address:=myadress, _
    ‘TextToDisplay:=kekka.Address

  5. abc より:

    stabuckyさん、ご回答ありがとうございました。
    感謝です!

  6. stabucky より:

    abcさん
    お役に立てて嬉しいです。

  7. ゆき より:

    まくろ初心者です。
    Excel2010で実行してみました。

    残念ながら、エラーが発生して、インデックスが有効範囲にありませんと出ます。

    myfn = Dir(myfolder & “\*.xls”, vbNormal)
    Sheets(resultsn).Selectここで止まっています。
    何か、改善できる方法がればよろしくお願いします。

  8. stabucky より:

    ゆきさん
    この行で実行が止まる、インデックスが有効範囲にない、ということから考えられるのは「検索結果」というシート名のシートがないということです。
    シートの名前を「検索結果」にして、実行してみてください。

  9. ゆき より:

    stabuckyさん、
    ご確認、ありがとうございます。
    Pathに合わせて正確に指定しなかったことが原因でした。
    実行してみたら、本当に使いやすいです~^^

  10. stabucky より:

    よかったです。お役に立てて嬉しいです。

  11. 雪だるま より:

    素晴らしいですね

    マクロって難しい・・・

    このマクロで複数ファイルのすべてのセルを検索できるんですが
    各シートのB列(名前を入れます)だけを検索するようには
    できるのでしょうか

    是非とも教えてください。

  12. stabucky より:

    >雪だるまさん
    「ファイルを検索」の
    10行目「mysheet.Cells.Find(myword)」
    24行目「mysheet.Cells.FindNext(kekka)」
    の「Cells」を「Range(“B1:B100”)」に書き換えればできると思います。
    「Cells」とするとシート全てのセルが対象になるので代わりに「Range」で範囲を指定すれば大丈夫だと思います。
    「B1:B100」でB列の1行から100行までを指定しています。足りなければ100を500とか1000にしてみてください。
    手元に確認できる環境がないので試せません。失敗したらごめんなさい。

  13. 雪だるま より:

    やったーーーーー

    出来ました。完璧です

    非常に嬉しいです(^^)

    ご教示のとおり、返還しましたらB列のみをきちんと検索してくれました
    まさに天才です

    ありがとうございました。
    感謝の言葉だらけです

  14. stabucky より:

    >雪だるまさん
    おお、よかったです。
    お役に立てて嬉しいです。

  15. ばーば より:

    初めまして初心者です宜しくお願いします。

    「実行時エラー(1004)ファイルが読めません」
    が出て下記の所で停止してしまいます。
    Workbooks.Open Filename:=myfn

    宜しくお願いします

  16. stabucky より:

    >ばーばさん

    「読めません」ということは「ファイルが存在しない」もしくは「ファイルが開けない」なのでしょう。手元の環境では確認できないのですが思い付く点を挙げます。

    (1)
    検索しようとしているExcelファイルは「.xls」でしょうか。
    「.xlsx」ならば「Sub 複数ファイルシート一括検索()」の
    「myfn = Dir(myfolder & “\*.xls”, vbNormal)」
    の部分を
    「myfn = Dir(myfolder & “\*.xlsx”, vbNormal)」
    または
    「myfn = Dir(myfolder & “\*.xls*”, vbNormal)」
    に書き直せばうまくいくかもしれません。

    (2)
    検索しようとしているExcelファイルが既に開いているとエラーになると思います。
    マクロをセットしたファイル以外のExcelファイルを全て閉じてから実行したらうまくいくかもしれません。

    状況を教えていただけたら幸いです。

  17. ばーば より:

    迅速な対応有難う御座います。
    説明が少なくてすみません

    検索しようとしているExcelファイルは「.xls」です。
    複数のファイルが存在します。

    「myfn = Dir(myfolder & “\*.xlsx”, vbNormal)」
    だと動作しません。

    「myfn = Dir(myfolder & “\*.xls*”, vbNormal)」
    の場合は、「Ifブロックに対応するEnd Ifがありません。」と出てしまいます。

    宜しくお願いします。

  18. stabucky より:

    前段はxlsx用の設定なのでxlsに対して動作しないのは想定内です。
    後段はxlsでもxlsxでも動作するための設定なのですがIfに関するエラーは想定外です。
    色々と変な状況を試しましたが再現しませんでした。申し訳ありません。
    もしよろしければコードの貼り付けからやり直してみてください。xlsだけが対象ならば元のコードで動くはずなので。

  19. えるさ より:

    \がパソコンで打てず、¥のままではマクロはちゃんとうごきませんよね?

  20. stabucky より:

    >えるささん
    上のコードでは「\」(実際は半角)で表示されていてもVisualBasicエディタにコピー&ペーストすると「¥」(実際は半角)で表示されませんか?
    VisualBasicエディタでは「¥」が正しいです。

コメントを残す

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

送信してください。


タグ

カテゴリー

最近の投稿

最近のコメント

固定ページ

アーカイブ

stabucky

写真

メタ情報