Treeコマンド結果をExcelに取り込む

Windows系OSでフォルダ構造と関連ファイルについて出力するtreeコマンドがあります。
下記のc:\tempフォルダについて、フォルダ構成とフォルダとファイルの構成を出力したサンプルを示します。

treeのみですと指定したカレントから下についてフォルダ構造のみ出力します。
tree /fはフォルダとファイルの両方を出力します。
コマンドプロンプトで表示されるより、> ファイル名.txtなどでテキスト出力してExcelに取り込むと階層が深い環境も体裁を整えることが出来きます。

システムフォルダのフォルダ構造をExcelに取り込んでみます。
C:\Windowsでtree > c:\tree.txtコマンドでテキストファイルに出力します。
下図はc:\windowsフォルダにカレントを移動した後にtree > c:\tree.txtでcドライブ直下にtree.txtファイルを作成し、treeコマンドの内容を書き込んでいます（終了まで数分間かかります）。

出力されたtree.txtは下図のようになります。

スペースやタブを可視化できるテキストエディターでtree.txtを見ると下図のようになっています。基本は半角ステース2個で階層化されています。

以下の手順で置換を行いテキスト内の線類を置き換えていきます。
尚、本ページをコピー＆ペーストしての使用は避けて下さい。所為事情でメモ帳しかテキストエディタが使えない場合、タブは置換ウィンドウでは入力できないので、本文中に一度タブを入力し、コピー＆ペーストして下さい。
置換の順番は上から実施して下さい。

│を半角スペース2個に置換
└を半角スペース2個に置換
─を半角スペース2個に置換
├を半角スペース2個に置換
” “（を半角スペース4個）を” “（タブ1個で置換）

置換が完了すると以下のフォーマットになります（タブ区切り、cvsファイル）。

Excelにインポートします。
[従来のウィザード]が容易かと思います。[テキストまたはCSVから]でも可能です。

従来のウィザードは標準では無いので、必要な場合、[Excelのオプション]の[データ]から[テキストから（レガシ）]をチェックします。

下記の選択であることを確認して[次へ]を選択。

[タブ]をチェックして、ウィザードの最後[完了]まで進めて下さい。

こんな感じで構造化データとして読み込まれます。
A列と1、2行は不要だと思いますので、削除するか、C:.をC:\Windowsに置き換えると体裁が整います。

行をグループ化すると、開いたり閉じたりできて（ドリルダウン）更に体裁がよくなります。

以下のサイトのマクロがよい感じなのでご紹介しておきます。
https://www.shegolab.jp/entry/excel-macro-outline-tree
ただ、Excle2013で使用したところ、エラー400が出てうまく動作しませんでしたので、簡単に修正したものを下記に記載します。
使用にはマクロの作成と実行の知識が必要になります。また、ご利用は自己責任でお願い致します。

Option Explicit

' 項番階層の区切り文字
Const NUMBER_SEPARATOR = "-"
' Const NUMBER_SEPARATOR = "."

Sub アウトライン_インデント階層()
    outlineTree probe:="indentLevel"
End Sub

Sub アウトライン_列下げ階層()
    outlineTree probe:="columnPosition"
End Sub

Sub アウトライン_項番階層()
    outlineTree probe:="multiNumbered"
End Sub

Private Sub outlineTree(probe As String)
    If TypeName(Selection) <> "Range" Then Beep: Exit Sub

    Dim titleRng As Range
    Set titleRng = Intersect(ActiveSheet.UsedRange, Selection.Areas(1))
    If titleRng Is Nothing Then Beep: Exit Sub

    Application.ScreenUpdating = False

    ActiveSheet.Outline.SummaryRow = xlAbove
    titleRng.ClearOutline
    Call traverseList(titleRng, 0, probe:=probe)

    Application.ScreenUpdating = True
End Sub

Private Function traverseList(curRng As Range, curLevel As Integer, probe As String, Optional doProc As String = "doGroup") As Range
    Dim i As Integer
    For i = 1 To curRng.Rows.Count - 1
        Dim subRng As Range
        Dim nextLevel As Integer

        Set subRng = Intersect(curRng, curRng.Offset(i))
        nextLevel = columnPosition(subRng.Rows(1), curLevel)
        If nextLevel > curLevel Then
            Set subRng = traverseList(subRng, nextLevel, probe, doProc)
            Set subRng = doGroup(subRng, nextLevel)
            i = i - 1 + subRng.Rows.Count
        ElseIf nextLevel < curLevel Then
            Exit For
        End If
    Next
    Set traverseList = curRng.Resize(i)
End Function

Private Function indentLevel(itemRow As Range, level As Integer) As Integer
    With itemRow.Cells(1)
        indentLevel = IIf(IsEmpty(.Value), 8, .indentLevel)
    End With
End Function

Private Function columnPosition(itemRow As Range, level As Integer) As Integer
    columnPosition = 0
    Dim c As Range
    For Each c In itemRow.Cells
        If Not IsEmpty(c) Then Exit Function
        columnPosition = columnPosition + 1
    Next
End Function

Private Function multiNumbered(itemRow As Range, level As Integer) As Integer
    With itemRow.Cells(1)
        multiNumbered = IIf(IsEmpty(.Value), 8, UBound(Split(.Text, NUMBER_SEPARATOR)))
    End With
End Function

Private Function doGroup(ByVal rng As Range, level As Integer) As Range
    rng.Rows.Group
    Set doGroup = rng
End Function

Private Function doInsertParent(ByVal rng As Range, level As Integer) As Range
    rng.Rows(1).EntireRow.Insert
    Set doInsert = Range(rng, rng.Offset(-1))
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

ご参考まで。

関連記事

TOP