Excel VBA 質問スレ Part83 (475ﾚｽ)

Excel VBA 質問スレ Part83 http://mevius.5ch.net/test/read.cgi/tech/1749348402/

上下前次1-新
通常表示 512ﾊﾞｲﾄ分割 ﾚｽ栞
抽出解除 必死ﾁｪｯｶｰ(本家) (べ) 自ID ﾚｽ栞 あぼーん

---

423: デフォルトの名無しさん [sage] 2025/07/17(木) 23:26:46.72 ID:DMF1qliv Chatさん。未検証 再帰使わずキュー処理 Sub FastSearchMinimal() Dim fso As Object, q As Collection, f As Object, i As Object Dim r As Long: r = 2 Dim k As String: k = "sample" Set fso = CreateObject("Scripting.FileSystemObject") Set q = New Collection: q.Add fso.GetFolder("C:\TestFolder") With Sheets(1): .Cells.Clear: .Range("A1:C1").Value = Array("種類", "名前", "パス"): End With Do While q.Count > 0 Set f = q(1): q.Remove 1 For Each i In f.SubFolders: q.Add i: If InStr(1, i.Name, k, vbTextCompare) > 0 Then WriteRow r, "フォルダ", i.Name, i.Path Next For Each i In f.Files: If InStr(1, i.Name, k, vbTextCompare) > 0 Then WriteRow r, "ファイル", i.Name, i.Path Next Loop MsgBox "完了" End Sub Sub WriteRow(ByRef r As Long, t As String, n As String, p As String) With Sheets(1): .Cells(r, 1).Resize(1, 3).Value = Array(t, n, p): End With: r = r + 1 End Sub http://mevius.5ch.net/test/read.cgi/tech/1749348402/423

---

ﾒﾓ帳

(0/65535文字)

---

上下前次1-新書関写板覧索設栞歴

---

ｽﾚ情報 赤ﾚｽ抽出 画像ﾚｽ抽出 歴の未読ｽﾚ AAｻﾑﾈｲﾙ

---

Google検索

Wikipedia

---

ぬこの手 ぬこTOP 1.090s*