複数ファイルシート一括検索(下階層対応版)
以前、「複数ファイルシート一括検索」という記事を書きました。複数のExcelファイルの全てのシートを対象として文字列検索をするマクロです。
フォルダ内の全てのファイルを対象としますが下の階層のフォルダには対応していませんでした。
今回、下の階層を含めて検索するように改良しました。
コードは四つあります。一枚のモジュールに貼り付けてください。
宣言
Const result_sheet = "検索結果"
Dim all_files(9999, 1) As String
Dim last_index As Long
Dim my_row As Long
まずモジュールレベル定数を宣言しています。「検索結果」という名前の空のシートを準備してください。ここに結果を表示します。
またモジュールレベル変数を三つ宣言しています。
ファイル名を取得する
'指定したフォルダにある全てのファイル名(パス付)を取得する。
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にセットします。フォルダの場合は再帰的にその中のファイルを取得します。
メイン
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
検索文字列とフォルダを指定します。対象となる全てのファイル、シートを取得し検索します。
検索・編集
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
指定したファイルの全てのシートについて、文字列を検索します。
検索結果を「検索結果」シートにセットします。
該当のセルにハイパーリンクを張るようになっています。
2020年8月12日追記
コードに誤りがありました。
VBEで作成したコードをこのブログにペーストするときに半角の「\」が消えてしまっていました。
これを修正しました。
修正を反映したbasファイルを添付します。上に載せたコードを一つずつコピペする代わりにインポートして使えます。
search.bas
[ 2015年5月22日 | カテゴリー: Excel | タグ: VBA , シート , 検索 ]
« 下の階層を含めたファイル一覧を作成するマクロ | 選択範囲を回転するマクロ »
コメント
-
＞えるささん
ちょっと調べましたが原因が分かりませんでした。
申し訳ありません。 -
えるさ より:
シートが30毎くらいあって、
一個めには、ヒットするんですが
二個目が検索できずエラーがでます。
ありがとうございました(;_;) -
てつや より:
マクロ利用させて頂いてます。
正常に稼働し、いままで時間がかかっていた
ことが瞬時に出来て泣きそうです。質問ですが、
検索にヒットしたセルが「N4」だった場合
「N4」と同じ行である
「A4」「B4」「C4」「D4」「E4」「L4」「M4」
のセル内容を、検索結果シートの「F列」以降に
表示させるにはどうしたら良いですか。ハイパーリンクで該当セルまで行かずに、
検索結果の表の中で見たい情報を網羅
したいと考えてます。お手数かと思いますが、よろしくお願い致します。
-
＞てつやさん
ご利用ありがとうございます。
質問いただいた件ですが、難しいです。
発見したセルだけでなく、その周辺のセルの情報を取得することになるので、ちょっと修正するだけでは済まないような気がします。
申し訳ありません。 -
了解しました。
大変失礼しました。頑張ってマクロの学習します！
また教えて下さい。
-
＞てつやさん
こちらこそよろしくおねがいします。 -
misson より:
Loop Whileのところでエラーがでるのは
シート内で結合セルのみがヒットすると
FindNextの結果がNothingになるからみたいですね -
＞missonさん
セルの結合は自分自身はなるべく使わないようにしているので想定していませんでした。
ありがとうございました。 -
ぶん より:
こちらでもすいません。当方は複数のドライブがある環境で、Bフォルダ（Aドライブ内にあります）を検索したいのですが、Bフォルダを指定しても「ファイルがみつかりません」となります。一方で、Aドライブを指定した場合、Aドライブ直下にあるエクセルは検索できます。何が原因か分からず、苦労しております。ぜひご指導頂きますと有難いです。
-
出来れば、フォルダ指定なく、指定のドライブ→フォルダを特定し、検索をかけたいのです。大変わがままな相談ですが、ぜひご指導くださいませ。
-
＞ぶんさん
複数ドライブの件は、少し考えましたが思いつきませんでした。
フォルダ指定の件は、フォルダを固定するということであれば
複数ファイルシート一括検索()の
With〜End With の箇所を削除し、代わりに
my_path=指定のフォルダ
のように書けばいいと思います。
お役に立てず申し訳ありません。 -
ありがとうございます！
早速試してみます -
あかんとく より:
シート名検索がしたくてたどり着きました。
マクロを実行してみたのですが、
「実行エラー’53′
ファイルが見つかりません」
と表示されます。
If GetAttr(this_path) = vbDirectory Then
この行のようですが、超初心者なので対応方法がわかりません。
ご教授していただけませんでしょうか？ -
あかんとくさん
時間のあるときに確認します。少しお待ちください。 -
あかんとくさん
コードを修正しました。
お手数をおかけして申し訳ありませんが再度試していただけますでしょうか。
よろしくおねがいします。 -
コード修正ありがとうございます。
やってみましたが、フォルダの下層フォルダを検索しようとすると同じエラーでストップします。
1層下げるととりあえず動きました。
ブックのリンクの確認が出るのは仕方ないですね。。。 -
あかんとくさん
ダメですか。これ以上の調査は難しいです。申し訳ありません。 -
ありがとうございました。
お手数かけました。。。 -
わいんだ より:
マクロ初心者です。
大変勉強になりす。
”検索文字列を入力”に何も入れずに実行すると
フォルダの中を全部検索するような感じになり、検索が
止まらなくなってしまいます。
ご教授していただけませんでしょうか？ -
わいんださん
search = InputBox(“検索文字列を入力”)
の後に
If search = “” Then Exit Sub
とするといいと思います。 -
カルピス より:
お忙しい中恐縮です。
コードの利用に利用条件などはございますでしょうか？
こちらのコードをひながたに機能をいくつか追加するような形でコードを記述したのですがもし何か細かい利用条件等(コード内にURLの記述など)あればお教えいただきたいです。
再公開などはしません。社内業務の効率化に使用したいと考えています。
もしコードの利用自体が難しいようでしたら参考にさせて頂いて1から書き直そうと思っています。 -
カルピスさん
利用いただきありがとうございます。
利用条件はありません。自由に改変いただいて結構です。
よろしくお願いします。 -
ありがとうございます！
すいません再公開？というか私が一部改変、追記したものを社内で共有して使うかもしれないです。
その辺は大丈夫ですかね… -
大丈夫というか、そのように利用させていただいてもいいでしょうか？
念のため許可をいただければと思いました。業務の効率化への利用だけです。 -
カルピスさん
問題ありません。自由に使ってください。 -
ありがとうございます！！
お忙しい中失礼いたしました！！
最大限活用させていただきます！！
許可というのは著作権的なものの確認ですのでご心配しないでください！ -
[…] 2015年5月22日追記 下階層(フォルダ内のフォルダ)に対応した版を作りました。「複数ファイルシート一括検索(下階層対応版)」 […]
先日は回答ありがとうございます！
マクロ初心者です。
早速このマクロ使わせていただきました！
しかし、実行時エラー91がでて、
オブジェクト変数または、Withブロック変数
が設定されていません。と、
でて、
Loop While Not kekka Is Nothing And kekka.Address first_address
でエラーがでます。
なにがだめなのでしょう？