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

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

上下前次1-新
通常表示 512ﾊﾞｲﾄ分割 ﾚｽ栞
抽出解除 ﾚｽ栞

---

ﾘﾛｰﾄﾞ規制です｡10分ほどで解除するので､他のﾌﾞﾗｳｻﾞへ避難してください｡

---

149: デフォルトの名無しさん [] 2025/06/19(木) 18:29:25.72 ID:CkE44pQz >>147 パブリック変数をコンストのノリで使用する事と、関数（public関数）を使う事は違う http://mevius.5ch.net/test/read.cgi/tech/1749348402/149

283: デフォルトの名無しさん [] 2025/06/27(金) 21:38:05.72 ID:1l5DAmC+ >>280 おい言ってみろよ それっぽいこと適当に言ってると低年収バレバレで失禁するぞ？ http://mevius.5ch.net/test/read.cgi/tech/1749348402/283

311: デフォルトの名無しさん [] 2025/06/30(月) 20:48:43.72 ID:XO4EHMtF >>310 ごめん、そんなことはないけど 印刷のVBA化に無理に固執するもんじゃない マジで 昔経験したからわかる http://mevius.5ch.net/test/read.cgi/tech/1749348402/311

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

426: デフォルトの名無しさん [sage] 2025/07/18(金) 08:22:30.72 ID:avd6O0J8 >>417 はちょっと手抜きしてたので、ちゃんと作り直した｡ Sub 使い方() 　Set Result = New Collection 　DirMulti "C:\Documents", "A???\B*\Excel\2025????\File*.xlsx", Result, vbNormal 　(以下略) End Sub Sub DirMulti(HomePath, SearchPath, ResultCollection, Optional Attributes As VbFileAttribute = vbNormal) 　Pos = InStr(SearchPath & "\", "\") 　Search = Left(SearchPath, Pos - 1) 　NextSearch = Mid(SearchPath, Pos + 1) 　Set SearchResult = New Collection 　Res = Dir(HomePath & "\" & Search, vbDirectory Or Attributes) 　Do While Res <> "" 　　If Res <> "." And Res <> ".." Then SearchResult.Add Res 　　Res = Dir() 　Loop 　If NextSearch = "" Then 　　For Each Res In SearchResult 　　　ResultCollection.Add HomePath & "\" & Res 　　Next 　Else 　　For Each Res In SearchResult 　　　If (GetAttr(HomePath & "\" & Res) And vbDirectory) <> 0 Then 　　　　DirMulti HomePath & "\" & Res, NextSearch, ResultCollection, Attributes 　　　End If 　　Next 　End If End Sub http://mevius.5ch.net/test/read.cgi/tech/1749348402/426

585: デフォルトの名無しさん [] 2025/08/03(日) 10:49:30.72 ID:46rmLnF/ ４〜５年も出来ない出来ないって愚痴ってる時間で手動で取り込んだら終わってたのにな http://mevius.5ch.net/test/read.cgi/tech/1749348402/585

---

ﾒﾓ帳

(0/65535文字)

---

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

---

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

---

Google検索

Wikipedia

---

ぬこの手 ぬこTOP 0.030s