Results of 1 - 1 of about 44 for VBA ファイル 一覧 階層 (0.014 sec.)
vba (14732), ファイル (15416), 一覧 (5018), 階層 (417)
- [[20230928163125]]
- #score: 10254
- @digest: 4ae9727b0b97b25606d7e1349150a217
- @id: 95181
- @mdate: 2023-10-12T09:14:43Z
- @size: 13491
- @type: text/plain
- #keywords: subtrees (64439), clstree (42959), foldrs (41734), nsubtree (36904), ┃┃┃┣□ (30483), ┗□ (29072), nitem (29072), continuous (28639), roots (26533), ┗ (23531), ┣ (22969), tree (22667), 図. (20803), ツリ (14841), delimiter (14607), subfolders (12412), ー構 (12197), ┃ (9935), bat (8141), test1 (7667), 階層 (7107), ンラ (6739), ダパ (5502), test2 (5121), test3 (4714), collection (4365), 構造 (3946), オン (3274), トレ (2975), パス (2837), 2023 (2711), ォル (2672)
- 『フォルダパスをツリー化表示させる方法がわかりません』（たか）
オンラインストレージのフォルダパスをツリー化して管理したいです。 オンラインストレージのフォルダパスは以下の形式(Excel)で抽出したのですが、ツリー化が出来なくて困っています。 やり方がわかる方がいらっしゃいましたらご教示ください。 オンラインストレージのフォルダパス A/a/01/TEST1 A/a/01/TEST2 A/a/01/TEST3 A/a/02/TEST1 A/a/02/TEST2 Excelで表示させたいツリー構造 A━a┳01┰TEST1 ┃ ┣TEST2 ┃ ┗TEST3 ┃ ┗02┰TEST1 ┗TEST2 なお、ExcelのSmartArtより階層構造を試しましたが、上記パスをコピペする全てのパスが選択されてしまいツリー構造になりませんでした。 ＜ 使用 Excel:Microsoft365、使用 OS:Windows10 ＞ ---- 以前、xyzさんに教えていただきました。 https://www.asahi-net.or.jp/‾ef2o-inue/vba_o/sub05_110_080.html （マナ） 2023/09/28(木) 16:57:13 ---- マナさん、コメントいただきまして誠にありがとうございます。 当方、VBAに疎いですがリンク先を参照させていただきました。 その中で質問ですが、今回のケースではオンラインストレージ上のファイル一覧の取得は行わず、 手元にあるExcelのデータ(フォルダパス)をツリー構造に変更することが目的となります。 ご共有いただいた内容は、上記目的と合致しているという理解で合っておりますでしょうか。 （たか） 2023/09/28(木) 17:20:36 ---- 失礼しました。そういう使い方はできません。 （マナ） 2023/09/28(木) 17:52:22 ---- SmartArtの階層構造でいいなら、一度ピボットでデータを整理してからやったらどうでしょう? データタブの区切り位置機能を使って/でセルごとに分け、タイトル行を追加する。 例） A B C D 1 第1階層 第2階層 第3階層 第4階層 2 A a 01 TEST1 3 A a 01 TEST2 4 A a 01 TEST3 5 A a 02 TEST1 6 A a 02 TEST2 ピボットを作る。タイトル行込みで全データを選択し、挿入タブからピボットテーブルを選択。 全データを「行」の位置に入れる。 ピボットの表内のセルをどこでもいいので選択。タブにデザインと言うのが出るので、そこを開く。 以下を設定 小計:小計を表示しない 総計:行と列の集計を行わない レポートのレイアウト:アウトライン形式で表示 あとは以下のURLのやり方参照で出来るかと思います。 https://extan.jp/?p=9697 （Q田） 2023/09/29(金) 14:22:28 ---- こんにちは。 > その中で質問ですが、今回のケースではオンラインストレージ上のファイル一覧の取得は行わず、 > 手元にあるExcelのデータ(フォルダパス)をツリー構造に変更することが目的となります。 ご紹介のありました井上さんのサイトを探せば、フォルダ一覧をツリー表示できるものがあると思います。 抽出も含めて対応できる既存の"枯れた"（つまり、多くの方の使用に耐えた）ツールがあるのですから、 こうしたものを援用したほうがよいと思います。 さはさりながら、お題の、テキストデータを元にして、ツリーを表示するものを参考までに示します。 Windows標準のTreeコマンドと同様の出力形式によるものを作成してみました。 （こちらが一般的な形式だと思います。） 提示された形式とやや違いますが、参考にしてください。 ちゃちゃっと作れる感じはしません。少なくとも面倒なものではあるでしょう。 修正事項があるとしても、明らかなバグ対応以外は時間を費やす積りはありませんので、 予め申し上げておきます。 <<データと作成例>> A列(元データ) C列(結果) A/a/01/TEST1 A A/a/01/TEST2 ┣ a A/a/01/TEST3 ┃ ┣ 01 A/a/02/TEST1 ┃ ┃ ┣ TEST1 A/a/02/TEST2 ┃ ┃ ┣ TEST2 A/b/01/TEST1 ┃ ┃ ┗ TEST3 A/b/01/TEST2 ┃ ┗ 02 A/b/01/TEST3 ┃ ┣ TEST1 A/b/02/TEST1 ┃ ┗ TEST2 A/b/02/TEST2 ┣ b A/c/01/TEST1 ┃ ┣ 01 B/a/01/test ┃ ┃ ┣ TEST1 B/b/01/test ┃ ┃ ┣ TEST2 ┃ ┃ ┗ TEST3 ┃ ┗ 02 ┃ ┣ TEST1 ┃ ┗ TEST2 ┗ c ┗ 01 ┗ TEST1 B ┣ a ┃ ┗ 01 ┃ ┗ test ┗ b ┗ 01 ┗ test <<参考コード>> Option Explicit Const letter1$ = "┣ " Const letter2$ = "┗ " Const letterC$ = "┃ " Const letterD$ = " " Dim foldrs As Object Dim subfolders As Object Dim line_continuous(1 To 10) As Boolean '接続線を書くか否か。なお、階層は上限10とした。（適宜修正のこと） Dim pos As Long '結果の書き込み位置 Sub main() Set foldrs = CreateObject("Scripting.Dictionary") Set subfolders = CreateObject("Scripting.Dictionary") Call set_foldrs 'foldrs: すべてのフォルダをkeyとする辞書(itemはEmpty)を作成 Call set_subfolders '辞書 subfolders を作成 'key : 各folder 'item: その直下のサブフォルダからなる辞書 Columns("C").ClearContents '書き出す列(C)を初期化 pos = 0 '結果の書き出し行の初期化 Dim root As Variant Dim roots As Object Set roots = get_roots '最上位のフォルダを得る 'Tree図をC列に書き出す For Each root In roots pos = pos + 1: Cells(pos, "C") = root Call recursion(root, 1) Next End Sub Function set_foldrs() Dim s$, ary, t$ Dim k&, j& For k = 1 To Cells(Rows.Count, "A").End(xlUp).Row s = Cells(k, "A") ary = Split(s, "/") For j = 0 To UBound(ary) If j = 0 Then t = ary(j) Else t = t & "/" & ary(j) foldrs(t) = Empty Next Next End Function Function set_subfolders() Dim re As Object Dim dic As Object Dim fldr, fldr2 Dim k& Set re = CreateObject("VBScript.RegExp") For Each fldr In foldrs re.Pattern = "^" & fldr & "¥/" & "[^/]+$" For Each fldr2 In foldrs If re.test(fldr2) Then If dic Is Nothing Then Set dic = CreateObject("Scripting.Dictionary") End If dic(fldr2) = Empty End If Next Set subfolders(fldr) = dic Set dic = Nothing Next End Function Function get_roots() As Object Dim dic As Object Dim k&, s$ Set dic = CreateObject("Scripting.Dictionary") For k = 1 To Cells(Rows.Count, "A").End(xlUp).Row s = Cells(k, "A") dic(Split(s, "/")(0)) = Empty Next Set get_roots = dic End Function Function recursion(folder As Variant, depth As Long) Dim a As Object Dim c2& Dim i&, k& Dim elem Dim elem2 Dim ary Dim s$ If Not subfolders(folder) Is Nothing Then Set a = subfolders(folder) c2 = a.Count line_continuous(depth) = True i = 0 For Each elem In a.keys ary = Split(elem, "/") elem2 = ary(UBound(ary)) i = i + 1 s = "" '接続線 For k = 1 To depth - 1 If line_continuous(k) = True Then s = s & letterC ' "┃ " Else s = s & letterD ' " " End If Next If i = c2 Then pos = pos + 1: Cells(pos, "C") = s & letter2 & elem2 Else pos = pos + 1: Cells(pos, "C") = s & letter1 & elem2 End If '最後のフォルダについては、接続線は不要 If i = c2 Then line_continuous(depth) = False Call recursion(elem, depth + 1) Next End If End Function （xyz） 2023/09/29(金) 14:47:26 ---- 井上さん? （?） 2023/09/29(金) 15:21:28 ---- マナさんが以下の日時でコメントしたサイトの管理人さんですね （マナ） 2023/09/28(木) 16:57:13 https://www.asahi-net.or.jp/‾ef2o-inue/vba_o/sub05_110_080.html ページ下部にこうあります Copyright(C) 2003,2023 井上 治,All Rights Reserved. （ねじねじ） 2023/09/29(金) 15:46:59 ---- （ねじねじ）さん了解です。 （?） 2023/09/29(金) 17:07:48 ---- ●一番手っ取り早いのは、 コマンドプロンプトで Treeコマンド を使うことです。 具体的には、 Tree 対象とするルートフォルダのパス とすれば、その配下のフォルダのTree図が表示されます。 ●また、 Tree 対象とするルートフォルダのパス > tree図.txt などと、テキストファイルにリダイレクトすれば、 テキストファイルに結果を書き込めます。 http://office-qa.com/win/win186.htm を参照。（何か結果図がおかしい気もします。） # ちなみに、提示したコードは、 # 以前に同種の質問があった際の私の回答をもとに、今回新たに作成したものです。 # 今後、同様の質問があった場合に、閲覧されている方に活かしていただければと思います。 （xyz） 2023/09/29(金) 22:48:26 ---- > Tree 対象とするルートフォルダのパス > tree図.txt > などと、テキストファイルにリダイレクトすれば、 > テキストファイルに結果を書き込めます。 マクロにしてみました。 念のため、空フォルダに、マクロブックを保存してください。 A列に、パスが列挙されている前提です。 Sub test() Dim r As Range, e Dim p As String, bat As String Set r = Range("a1", Cells(Rows.Count, 1).End(xlUp)) p = ThisWorkbook.Path & "¥" bat = p & "tree.bat" Open bat For Output As #1 For Each e In r.Value Print #1, "md ""tmp¥" & Replace(e, "/", "¥") & """" Next Print #1, "tree tmp > """ & p & "tree図.txt""" Print #1, "rd /s/q tmp" Close #1 CreateObject("wscript.shell").Run """" & bat & """", 0, True Kill bat End Sub （マナ） 2023/10/02(月) 08:52:02 ---- 興味があったので作ってみました 参考出品 イミディエイトウインドウに書き出しますがごそこは勘弁ください '-------- 標準モジュール ---------------------- Sub sample() Dim tree As clsTree, aCell As Range Set tree = New clsTree tree.Delimiter = "/" For Each aCell In Range("A2", Cells(Rows.Count, "A").End(xlUp)) tree.AddTree aCell.Value Next tree.PrintTree End Sub '-------- クラスモジュール clsTree ------------ Public Name As String Public SubTrees As Collection Public Items As Collection Public Delimiter As String Private Sub Class_Initialize() Set SubTrees = New Collection Set Items = New Collection Name = "Root" Delimiter = "¥" End Sub Public Sub AddTree(newName As String) Dim path() As String, tree As clsTree path = Split(newName, Delimiter) Set tree = Me If UBound(path) = 0 Then tree.Items.Add path(0), path(0) Else On Error GoTo AddNew Set tree = SubTrees(path(0)) On Error GoTo 0 tree.AddTree Mid(newName, Len(path(0)) + 2) End If Exit Sub AddNew: tree.SubTrees.Add New clsTree, path(0) tree.SubTrees(path(0)).Name = path(0) tree.SubTrees(path(0)).Delimiter = Delimiter Resume End Sub Public Sub PrintTree(Optional ByVal pre As String = "") Dim tree As clsTree Dim i As Long, nSubTree As Long, nItem As Long nSubTree = SubTrees.Count: nItem = Items.Count For i = 1 To nSubTree Debug.Print pre & IIf(i = nSubTree And nItem = 0, "┗■", "┣■") & SubTrees(i).Name SubTrees(i).PrintTree pre & IIf(i = nSubTree And nItem = 0, " ", "┃") Next For i = 1 To nItem Debug.Print pre & IIf(i = nItem, "┗□", "┣□") & Items(i) Next End Sub xyzさん 2023/09/29(金) 14:47:26 のサンプルデータで実行するとこうなります ┣■A ┃┣■a ┃┃┣■01 ┃┃┃┣□TEST1 ┃┃┃┣□TEST2 ┃┃┃┗□TEST3 ┃┃┗■02 ┃┃ ┣□TEST1 ┃┃ ┗□TEST2 ┃┣■b ┃┃┣■01 ┃┃┃┣□TEST1 ┃┃┃┣□TEST2 ┃┃┃┗□TEST3 ┃┃┗■02 ┃┃ ┣□TEST1 ┃┃ ┗□TEST2 ┃┗■c ┃ ┗■01 ┃ ┗□TEST1 ┗■B ┣■a ┃┗■01 ┃ ┗□test ┗■b ┗■01 ┗□test （´・ω・`） 2023/10/02(月) 12:14:01 ---- 皆様、ご教示いただきまして誠にありがとうございます。 お陰様で階層データ化の生成を行えることが出来ました （たか） 2023/10/12(木) 11:51:02 ---- マナさん、ご教示いただきましてありがとうございます。 下記マクロを実行することで階層データ化および抽出することが出来ました。 もう一点質問となります。 初歩的な質問で恐縮ですが、batファイルを生成しない/叩かないで変換する方法はあるのでしょうか? 可能であれば、マクロが有効となったExcel上で動作が完結できればなと思っております。 Sub test() Dim r As Range, e Dim p As String, bat As String Set r = Range("a1", Cells(Rows.Count, 1).End(xlUp)) p = ThisWorkbook.Path & "¥" bat = p & "tree.bat" Open bat For Output As #1 For Each e In r.Value Print #1, "md ""tmp¥" & Replace(e, "/", "¥") & """" Next Print #1, "tree tmp > """ & p & "tree図.txt""" Print #1, "rd /s/q tmp" Close #1 CreateObject("wscript.shell").Run """" & bat & """", 0, True Kill bat End Sub （マナ） 2023/10/02(月) 08:52:02 （たか） 2023/10/12(木) 11:54:14 ---- > batファイルを生成しない/叩かないで変換する方法はあるのでしょうか? xyzさん、（´・ω・`）さんから提示されていますが… （マナ） 2023/10/12(木) 18:14:43... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202309/20230928163125.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97048 documents and 608239 words.
訪問者：