│ layer1_content.txt
│
├─layer1_1
│ │ layer2_content.txt
│ │
│ ├─layer2_1
│ │ layer3_content1.txt
│ │ layer3_content2.txt
│ │
│ └─layer2_2
このようなディレクトリ構造を表すのに、データとして扱いやすいのは以下のようなテーブルだ。フィルタかけて絞り込みもできるし、絞り込まれたとき1行分だけ表示されてもその階層構造がわかる。（さらに条件付き書式で上のセル＝自セルなら薄いグレーにする設定をすると、見た目もわかりやすい）
表A）各ファイルやディレクトリがそれぞれの階層を示すタブ区切りで表現されています。この形式では、ファイルパスを全て一行で表示し、階層の深さをタブで示しています。
| layer1_content.txt | ||
| layer1_1 | layer2_content.txt | |
| layer1_1 | layer2_1 | layer3_content1.txt |
| layer1_1 | layer2_1 | layer3_content2.txt |
| layer1_1 | layer2_2 | layer2_content.txt |
が、これだと横幅をとるので、横幅をとりたくないとき
＝階層構造は明確に見せる必要があるけど、内容自体は右側に列記するので、表示の固定で見えなくさせるとかで対処するのが不適切な場合
＝パターン表、チェックリストなど
そういうときに以下のような表がたまにある。
表B)階層構造がインデントによって示され、ディレクトリとファイルの関係が視覚的に明確になります。この形式では、ディレクトリとその配下のファイルが分かりやすく表示されています。
| layer1_content.txt | ||
| layer1_1 | ||
| layer2_content.txt | ||
| layer2_1 | ||
| layer3_content1.txt | ||
| layer3_content2.txt | ||
| layer2_2 | ||
| layer2_content.txt |
表B嫌いです。データとして扱いにくい。作るのも手作りにせざるを得ない。
あとどう表現していいのかわかりませんよね。上にはcopilotに書かせた表現ですが、明確なキーワードがなくてピンときません。
ともかくこれをVBAでコーディングさせたのでメモ。まだ試していませんから、動く気がしていませんが、、。
treeから表A
これは本当はtreeでなくdirで出したほうが表にしやすいんですけどね、、少なくとも関数でやる場合には。
Sub ListFilesInDirectory()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
ws.Cells.Clear
Dim folderPath As String
folderPath = "C:\Your\Directory\Path" ' 実際のディレクトリパスに変更してください
Dim row As Long
row = 1
' ファイルのリストを開始
ListFiles folderPath, ws, row, ""
End Sub
Sub ListFiles(folderPath As String, ws As Worksheet, ByRef row As Long, parentPath As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim folder As Object
Set folder = fso.GetFolder(folderPath)
Dim subfolder As Object
For Each subfolder In folder.Subfolders
ListFiles subfolder.Path, ws, row, parentPath & subfolder.Name & vbTab
Next subfolder
Dim file As Object
For Each file In folder.Files
ws.Cells(row, 1).Value = parentPath & file.Name
row = row + 1
Next file
End Sub
表Aから表B
Sub FormatDirectoryStructure()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' 新しいシートを追加して出力用に設定
Dim newWs As Worksheet
Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
newWs.Name = "FormattedStructure"
Dim i As Long, newRow As Long
newRow = 1
For i = 1 To lastRow
Dim line As String
line = ws.Cells(i, 1).Value
Dim parts() As String
parts = Split(line, vbTab)
Dim indentLevel As Integer
indentLevel = UBound(parts)
For j = 0 To indentLevel
newWs.Cells(newRow, j + 1).Value = parts(j)
Next j
newRow = newRow + 1
Next i
' 罫線の追加
With newWs.UsedRange.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
End With
With newWs.UsedRange.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
End With
With newWs.UsedRange.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
End With
With newWs.UsedRange.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
End With
With newWs.UsedRange.Borders(xlInsideVertical)
.LineStyle = xlNone
End With
With newWs.UsedRange.Borders(xlInsideHorizontal)
.LineStyle = xlNone
End With
Dim lastCol As Long
lastCol = newWs.Cells(1, newWs.Columns.Count).End(xlToLeft).Column
For i = 1 To lastRow
For j = 1 To lastCol
If newWs.Cells(i, j).Value <> "" Then
With newWs.Cells(i, j).Borders(xlEdgeRight)
.LineStyle = xlNone
End With
' 下線の設定
If newWs.Cells(i, j).Value <> "" And newWs.Cells(i + 1, j).Value = "" Then
With newWs.Cells(i, j).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
End With
Else
With newWs.Cells(i, j).Borders(xlEdgeBottom)
.LineStyle = xlNone
End With
End If
End If
Next j
Next i
End Sub
表Bから表A
Sub ConvertTableBtoTableA()
Dim wsB As Worksheet
Dim wsA As Worksheet
Dim lastRowB As Long
Dim lastRowA As Long
Dim currentRowB As Long
Dim currentRowA As Long
Dim currentIndent As Integer
Dim cell As Range
' 表Bが存在するシートを設定
Set wsB = ThisWorkbook.Sheets("Sheet1") ' Sheet1を表Bのあるシート名に変更してください
lastRowB = wsB.Cells(wsB.Rows.Count, 1).End(xlUp).Row
' 表Aを出力するための新しいシートを追加
Set wsA = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsA.Name = "TableA"
currentRowA = 1
' 表Bを読み取り、表Aに変換
For currentRowB = 1 To lastRowB
Set cell = wsB.Cells(currentRowB, 1)
currentIndent = cell.IndentLevel
' タブ区切りで階層を示す
If currentIndent > 0 Then
wsA.Cells(currentRowA, 1).Value = String(currentIndent, vbTab) & cell.Value
Else
wsA.Cells(currentRowA, 1).Value = cell.Value
End If
currentRowA = currentRowA + 1
Next currentRowB
' 罫線の追加
With wsA.UsedRange.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
End With
With wsA.UsedRange.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
End With
With wsA.UsedRange.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
End With
With wsA.UsedRange.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
End With
With wsA.UsedRange.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
End With
With wsA.UsedRange.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
End With
' 同じディレクトリ名のセルを薄いグレーに変更
For currentRowA = 2 To wsA.Cells(wsA.Rows.Count, 1).End(xlUp).Row
If wsA.Cells(currentRowA, 1).Value = wsA.Cells(currentRowA - 1, 1).Value Then
wsA.Cells(currentRowA, 1).Font.Color = RGB(192, 192, 192) ' 薄いグレーに設定
End If
Next currentRowA
End Sub
