Построить дерево как представление данных в Excel?
Таким образом, у меня есть своя сырая информация:
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?
- TreeView в Excel с помощью c #
- Выберите узел в TreeView с VBA
- Флажок Tri-State в excel VBA
- Ошибка ReleaseObject при экспорте в Excel
- Скопируйте данные Python PyQt QTreeView из Python в Excel с помощью копирования / вставки?
- Как экспортировать данные datagridview и treeview в excel в c #?
- Как выполнить цикл с помощью вторичных (дочерних) полей таблицы сводных таблиц Excel?
- Excel VBA «Ошибка автоматизации» из-за обновления Office 2010, возможно, вызванного MSCOMCTL.OCX (Microsoft Windows Common Controls 6.o (Service Pack 6))
- Qt отправляет данные из form1 в компонент formview tree2
- Excel Data для TreeView C #
- Рекурсивное дерево TreeView (с использованием цветов)
- Перенос названной структуры диапазонов в treeview (treestructure)
- Выбор узла treeview всегда возвращает первый узел дерева вместо выбранного
Я уверен, что вы можете это убрать, но это будет работать с набором данных, который вы предоставили.
Прежде чем начать, вам нужно будет определить два имени (Insert / Name / Define). «Данные» – это диапазон вашего набора данных, «Место назначения» – это место, где вы хотите, чтобы дерево прошло.
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
Я должен был найти это решение сегодня, и я нашел его в другом месте, если кто-то ищет этот ответ все еще
Укажите желаемый лист как «INPUT»
и выходной лист как «УРОВЕНЬ СТРУКТУРЫ»,
Форма находится в parent | child parent | child , поэтому, если ваши данные обратные просто заменяют столбцы. Если это самый верхний узел, введите root в качестве имени для parent .
Таким образом, каждая ячейка в столбцах A, B имеет некоторое значение в ней
запустить excel vba
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