フォルダの中を検索

いつもお世話になっております。
下記のコードは検索フォルダの中にある

エクセルすべてを検索して
どのワークブックに含まれているかを
シートに書き込んでしらべるというものに
なります。
ネットで検索して調べました。

意外と時間がかかってしまいます。
やく、50秒ほどです。
10秒ぐらいに短縮することは
できますでしょうか

できるからいましたら
おしえてくれませんでしょうか

コードになります。

フォルダの中には5個だけあります。



Private Sub CommandButton1_Click()
Dim WSC As Object
Dim kword As String, fpath As String, fname As String, fadd As String
Dim wb As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim frng As Range, r As Long

kword = TextBox1.Value
If StrPtr(kword) = 0 Then Exit Sub

Application.ScreenUpdating = False
Set sh1 = ActiveSheet
r = 1

fpath = "C:\Users\user\OneDrive\デスクトップ\検索フォルダ\"
fname = Dir(fpath & "*.xlsm", vbNormal)

Do Until fname = ""
Set wb = Workbooks.Open(fpath & fname)

For Each sh2 In wb.Worksheets

With sh2.Cells
Set frng = .Find(What:=kword, LookIn:=xlValues, LookAt:=xlPart)
If Not frng Is Nothing Then
fadd = frng.Address

Do
r = r + 1
sh1.Cells(r, 1).Value = fname
Set frng = .FindNext(frng)
If frng Is Nothing Then Exit Do
Loop Until frng.Address = fadd

End If

End With
Next sh2
wb.Close
fname = Dir()
Loop
Set WSC = Nothing
Application.ScreenUpdating = True

End Sub

質問者からの補足コメント

• 

  とくにこだわりありません。
  早く検索できればいいのですが。

    補足日時：2022/03/13 21:27

• シートの構成は添付ファイルのようになっています。
  Ｃ列で名前を検索
  シートは1月から12月まで存在しています。
  ×5年分となります。

  
  No.1の回答に寄せられた補足コメントです。 補足日時：2022/03/13 21:34

• 

  ブックを開いて閉じるのに時間がかかるみたいです。

    補足日時：2022/03/13 21:39

• 

  どのファイルに存在するか調べて
  そのファイルを開いて確認するだけです。

  No.2の回答に寄せられた補足コメントです。 補足日時：2022/03/13 21:40

• 

  そんなに急いでいません。
  明日、いろいろ調べるつもりです。

    補足日時：2022/03/13 21:45

• 

  ブックが５個なら先に全て開いておいて検索し
  するのはよいですが
  どうやって検索するのですか

  No.3の回答に寄せられた補足コメントです。 補足日時：2022/03/13 21:47

No.6 ベストアンサー 回答者： Qchan1962 回答日時： 2022/03/14 00:46

こんばんは

メインの処理が良く分かりません。
r = r + 1
sh1.Cells(r, 1).Value = fname
＝fname & sh2.Nameかな
にしても
WorksheetFunction.CountIf(sh2.UsedRange, "*" & kword & "*")
で良さそう・・かな

開くのに時間がかかると解っているのなら、対象のデータをExcelでなく
カンマ区切りtxtやcsvに加工した方が早そうですね。
60ファイルの検索位なら望まれている処理速度になると思います。

まあ、加工データを作る時、少し時間がかかると思いますが1度だけですし
対象のExcelを保存する時にcsvなどを吐くようにしておけば、気にならない
処理で済むのでは無いかと思いますよ。

WorksheetFunction.CountIfでやるなら
.xlsmを開くのでEnableEvents = False　も・・意味なかったかも

Private Sub CommandButton1_Click()
Dim WSC As Object
Dim kword As String, fpath As String, fname As String
Dim wb As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim AryFile()
Dim n As Integer
kword = TextBox1.Value
If StrPtr(kword) = 0 Then Exit Sub
Set sh1 = ActiveSheet
fpath = "C:\Users\user\OneDrive\デスクトップ\検索フォルダ\"
fname = Dir(fpath & "*.xlsm", vbNormal)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Do Until fname = ""
Set wb = Workbooks.Open(fpath & fname)
For Each sh2 In wb.Worksheets
If WorksheetFunction.CountIf(sh2.UsedRange, "*" & kword & "*") <> 0 Then
ReDim Preserve AryFile(n)
AryFile(n) = fname & ":" & sh2.Name
n = n + 1
End If
Next sh2
wb.Close
fname = Dir()
Loop
sh1.Range("A1").Resize(UBound(AryFile) + 1) = WorksheetFunction.Transpose(AryFile)
Set WSC = Nothing
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

この回答へのお礼

ありがとうございました。

お礼日時：2022/03/14 07:50

No.7 回答者： めぐみん_ 回答日時： 2022/03/14 07:01

敢えてコードは回答せず、もう少し考え方を身に付けて欲しかったですけど。

かれこれ２年程経つと思いますが、やりたいことの手順がコードを受け取ることで抜けてしまっていると感じだしましたので。

SQLってのもBOOKに順に接続させるのはともかく、12シートの名前を開かず取得できるのかと言う点が抜けてませんか？
一応ヒントは出したつもりですが、そこからコード化するのをまずは自力でやってみないと。
他力本願では益々組み立てる知識が身に付かないと思いますよ。
どちらになりたいのかは自由ですが、２年前の方が積極的な人と感じてましたのにちょっと残念です。

No.5 回答者： めぐみん_ 回答日時： 2022/03/13 22:40

No.3の補足について。

応用だと思いますよ。
どのワークシートに対してってのは出来ていますから、同じようにどのワークブックに対してってのも出来るはず。
無論自Book名と同じになった場合は除外する。

そしてBookオブジェクト変数から個々のBookのSheetオブジェクトへと繋ぐだけでは？

Findメソッドについては私も有無だけの為もですけど、繰り返し検索をしても何も利用されていないように思えます。
もう一度何をしたいのかについてコード以前に考え方を纏めるのが宜しいかと。

この回答へのお礼

いつもありがとうございます。
検索してら ExecuteExcel4Macroで検索できるか
ためしてみます。これなら開いて閉じるのが省けます
しかし、それならSQLのほうがいいのかな

お礼日時：2022/03/13 22:44

No.4 回答者： fujillin 回答日時： 2022/03/13 22:22

こんばんは

ほとんどの時間はブックの開/閉に使われていると推測できますので、速度の向上はあまり見込めないと思います。
少しくらい要領を良くできたとしても、全体の時間にはほとんど影響はないと思われますので。

シートの実態がどうなのかやシート内のデータ量がまったくわかりませんが、FINDメソッドは検索回数が多いと遅くなるようです。
https://officedic.com/excel-vba-highspeed-find/

他に可能性がありそうなのは、せいぜい、
　・画面の更新を止める
　・シートの再計算を止める
　　（こちらは、関数の設定状態によっては効果ありません）
くらいかと思われます。
（たいして効果があるとは思えませんが・・）

この回答へのお礼

ありがとうございました。
参考にいたします。

お礼日時：2022/03/13 22:25

No.3 回答者： めぐみん_ 回答日時： 2022/03/13 21:45

ブックが５個なら先に全て開いておいて検索し、見つからないBookは閉じればいいのでは？

No.2 回答者： めぐみん_ 回答日時： 2022/03/13 21:38

No.1です。

あとファイル名を書き込んでいるみたいですが、１つのシートに検索値があったとして他のセルやシートを調べる必要はあるのでしょうか？

何かCOUNTIF関数を使いシート内で有無を調べるだけで良いような気もしますけど、目的が不明なので違うのかな？

No.1 回答者： めぐみん_ 回答日時： 2022/03/13 21:30

検索するセル範囲を狭めるとか？

あとはどのようなシート構成になっているかにもよるかも。