Excel에서 데이터 표현과 같은 트리를 작성 하시겠습니까?

Question

나는 이런 방식으로 많은 원시 데이터를 가지고있다 :

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 만 사용하면 쉽게이 작업을 수행 할 수 있습니까?

Answer 1

이 기능을 정리할 수는 있지만 제공 한 데이터 세트에서 작동합니다.

시작하기 전에 두 개의 이름 (삽입/이름/정의)을 정의해야합니다. "데이터"는 데이터 집합의 범위이고, "대상"은 트리를 이동하려는 지점입니다.

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 

Answer 2

오늘은이 솔루션을 지켜 볼 수밖에 없었습니다와 나는 아직도

당신이 "INPUT"

과 출력으로 원하는 시트를 지정하는 경우에 사람이 대답을 찾고, 다른 곳에서 발견 "LEVEL 구조"

형태로 시트 parent | child에 있으므로 데이터 인 경우 뒤로 만 열을 교환하는 경우 parent의 이름으로 root에 넣어 그것 최상위 노드. 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 

: 열의 모든 셀 A, B가 어떤 가치를 가지고

그 방법은

실행에 VBA를

SOURCE 엑셀