在Excel中构build一个像数据表示的树？
我有一堆这样的原始数据：
Parent | Data --------------- Root | AAA AAA | BBB AAA | CCC AAA | DDD BBB | EEE BBB | FFF CCC | GGG DDD | HHH 哪些需要转换成像时尚树。 这基本上需要最终在一个Excel电子表格。 如何将上述数据转换为以下内容：
AAA | | | BBB | | | EEE | | FFF | CCC | | | GGG | DDD | | | HHH
有没有简单的方法来做到这一点只使用VBA？
我相信你可以整理这些，但是这将在你提供的数据集上工作。
在开始之前，您需要定义两个名称（插入/名称/定义）。 “数据”是数据集的范围，“目的地”是您希望树的位置。
Sub MakeTree() Dim r As Integer ' Iterate through the range, looking for the Root For r = 1 To Range("Data").Rows.Count If Range("Data").Cells(r, 1) = "Root" Then DrawNode Range("Data").Cells(r, 2), 0, 0 End If Next End Sub Sub DrawNode(ByRef header As String, ByRef row As Integer, ByRef depth As Integer) 'The DrawNode routine draws the current node, and all child nodes. ' First we draw the header text: Cells(Range("Destination").row + row, Range("Destination").Column + depth) = header Dim r As Integer 'Then loop through, looking for instances of that text For r = 1 To Range("Data").Rows.Count If Range("Data").Cells(r, 1) = header Then 'Bang! We've found one! Then call itself to see if there are any child nodes row = row + 1 DrawNode Range("Data").Cells(r, 2), row, depth + 1 End If Next End Sub
我今天不得不查找这个解决scheme，而且我在其他地方find了这个解决scheme，以防有人在寻找这个答案
指定您想要的工作表为“INPUT”
和输出表作为“LEVEL STRUCTURE”
表单在parent | child parent | child ，所以如果你的数据是倒退只是交换列如果它的最上面的节点，放在root作为parent的名字。
这样，A，B列中的每个单元格都具有一定的价值
运行excel vba
消息来源： https ： //sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/text-functions/cascading-tree
Option Explicit Sub TreeStructure() 'JBeaucaire 3/6/2010, 10/25/2011 'Create a flow tree from a two-column accountability table Dim LR As Long, NR As Long, i As Long, Rws As Long Dim TopRng As Range, TopR As Range, cell As Range Dim wsTree As Worksheet, wsData As Worksheet Application.ScreenUpdating = False 'Find top level value(s) Set wsData = Sheets("Input") 'create a unique list of column A values in column M wsData.Range("A:A").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=wsData.Range("M1"), Unique:=True 'Find the ONE value in column M that reports to no one, the person at the top wsData.Range("N2", wsData.Range("M" & Rows.Count).End(xlUp) _ .Offset(0, 1)).FormulaR1C1 = "=IF(COUNTIF(C2,RC13)=0,1,"""")" Set TopRng = wsData.Columns("N:N").SpecialCells(xlCellTypeFormulas, 1).Offset(0, -1) 'last row of persons listed in data table LR = wsData.Range("A" & wsData.Rows.Count).End(xlUp).Row 'Setup table Set wsTree = Sheets("LEVEL STRUCTURE") With wsTree .Cells.Clear 'clear prior output NR = 3 'next row to start entering names 'Parse each run from the top level For Each TopR In TopRng 'loop through each unique column A name .Range("B" & NR) = TopR Set cell = .Cells(NR, .Columns.Count).End(xlToLeft) Do Until cell.Column = 1 'filter data to show current leader only wsData.Range("A:A").AutoFilter Field:=1, Criteria1:=cell 'see how many rows this person has in the table LR = wsData.Range("A" & Rows.Count).End(xlUp).Row If LR > 1 Then 'count how many people report to this person Rws = Application.WorksheetFunction.Subtotal(103, wsData.Range("B:B")) - 1 'insert that many blank rows below their name and insert the names cell.Offset(1, 1).Resize(Rws).EntireRow.Insert xlShiftDown wsData.Range("B2:B" & LR).Copy cell.Offset(1, 1) 'add a left border if this is the start of a new "group" If .Cells(.Rows.Count, cell.Column + 1).End(xlUp).Address _ <> cell.Offset(1, 1).Address Then _ .Range(cell.Offset(1, 1), cell.Offset(1, 1).End(xlDown)) _ .Borders(xlEdgeLeft).Weight = xlThick End If NR = NR + 1 'increment to the next row to enter the next top leader name Set cell = .Cells(NR, .Columns.Count).End(xlToLeft) Loop Next TopR 'find the last used column i = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), _ SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'format the used data range With Union(.Range(.[B1], .Cells(1, i)), .Range("B:BB").SpecialCells(xlCellTypeConstants, 23)) .Interior.ColorIndex = 5 .Font.ColorIndex = 2 .Font.Bold = True .HorizontalAlignment = xlCenter End With .Range("B1").Interior.ColorIndex = 53 .Range("B1").Value = "LEVEL 1" .Range("B1").AutoFill Destination:=.Range("B1", .Cells(1, i)), Type:=xlFillDefault End With wsData.AutoFilterMode = False wsData.Range("M:N").ClearContents wsTree.Activate Application.ScreenUpdating = True End Sub