複数ブック内の文字列検索プログラム

昨年異動した際に勝手がわからず、売上額等の集計ファイルを月ごとに作成していました。

しかし毎年継続して利用がある特定の取引先が、利用が個人の都合で決まったりしてしかも新規の利用もあるし、昨年どうだったっけ？みたいなことを調べたい時があります。でもいつ来てるかパッとわからないので、すべてのブックを順に開いて検索をかける、みたいな感じで結構面倒だったんですね。

しかも勿論そういうのは一社だけではないと。そのたびに時間がかかってお待たせするし、自分の業務は滞るしで、いいことないぞと。


なので、検索プログラムを書こうと思い立ちまして。

具体的には、指定フォルダ内のExcelファイルを再帰的に検索するというやつですね。

で、いちいちWorkbook.Openを使っても結構面倒なので、ブックを開かずにデータ取得を行うためにApplicationオブジェクトのExecuteExcel4Macroを使ってみたんです。ところがこれが遅いのなんのって。

検索も同じくApplicationオブジェクトのFileSearchを使って、比較的コーディングしやすかったんですがこれはちょっともう遅すぎてアレだと。実用的じゃないと。だって手動でブック開いて[Ctrl]+[F]した方が速いんですもの。


だで、折角ならもっと汎用的に使えるよう、WSH利用の独立アプリを作ってやろうじゃねーかみたいな気持ちに。だって、どうせFileSystemObject使うならディレクトリ指定させて、キーワード指定させて、自由に文字列検索できたら便利じゃないですか。

しかしどうにもこうにもWSHがうまく動いてくれない。おっかしいなぁVBScriptならVBAと大差ないんじゃないの？

とか思っていた私が悪いです、はい。だってExcel VBAならExcel開いとくだけで利用できるコレクションとかメソッドとかも、VBScriptだといちいちオブジェクト定義したりコレクションの参照方法が違ったりしますもんね。そりゃそうだよな。

実際問題、Excelでならガンガン走って(Workbook.Openを繰り返すのでそれでも多少は時間取られるんですけど)くれるので、全編スクリプトで動作させるのはちょっともう諦めてExcelブックを裏側で呼び出しマクロ実行させる仕様に変更です。まあ良くある手ですし、こう言う便利モノは速く済ませないと費用対効果もアレですし。


という訳でこちら。核になる処理をするExcelブックに記述したコードです。

'***データ仕様*************
'1)hogeの後に3桁連番のファイル名
'2)各hogeシートのデータは、左フィールドから日付/属性/氏名～
'3)属性フィールド内のテキストを指定して検索する
'==========================

Sub Search_Txt()
 Const myPath = "C:\hoge"
 Dim obj, bk, sh, myReg, i, Cnt, Ans
 Dim  FSO, File, myStr, Seeks, Header
 Header = "検索結果："

 Set FSO = CreateObject("Scripting.FileSystemObject")
 myStr = InputBox("検索したい文字列を入力して下さい。")

'検索結果をテキストファイルに残す
 Open myPath & "\SearchLog" & Format(Now(), "yyyymmdd") & ".txt" For Output As #1
 Print #1, Header

 For Each File In FSO.GetFolder(myPath).Files
 If File.Name Like "hoge*.xls" Then
  Set obj = CreateObject("Excel.Application")
  Set bk = obj.Workbooks.Open(myPath & "\" & files.Name)
  Set sh = bk.Sheets("hoge")  'SheetのIndex番号が判ればそれでもいい
  Set myReg = sh.Range("A7:N600") '最終行取得がメンドイので
  For i = 7 to 600
  If myReg(i,1) = "" Then Exit For 'データなくなったらFor文脱出
  If myReg(i,2) Like "*" & myStr & "*" Then
   Seeks = Mid(File.Name, 5, 3) & " " & i & "行目：" & myReg(i, 1) _
   & " " & myReg(i, 3) & Chr(13)
   Print #1, Seeks
   Cnt = Cnt + 1
  End If
  Next i
  bk.Close SaveChanges:=False
  obj.Quit
  Set obj = Nothing
 End If
 Next
 Close #1
 Ans = Header & Cnt & "件" & Chr(13) & Ans
 MsgBox Ans & Chr(13) & "検索結果をログファイルに出力しました。", vbInformation
 Set FSO = Nothing
End Sub

さらにWorkbook.OpenイベントでSearch_Txtを呼び出すコード設置までやっておけば、マクロ用ブックを呼び出すコードをvbsテキストファイルに記述、本処理はバッチファイルでも良いでしょうし、まあ何ならショートカットを設定してアイコンを変更して、とかにしましょうかね。そんなとこです。

これでさらにFileSystemObjectでデイレクトリ選択と、選択した場所の処理対象ファイル数を取得してプログレスバー表示とかまでさせれば立派に汎用アプリとして通用しま…すでしょうかねえ。どうだろなぁ。

ちょっとまだ遅い感じがするので、素人アプリの域を出なさそうです。精進しましょう。