Построить дерево как представление данных в 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?

Я уверен, что вы можете это убрать, но это будет работать с набором данных, который вы предоставили.

Прежде чем начать, вам нужно будет определить два имени (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

ИСТОЧНИК: 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 
  • Excel VBA заполняет TreeView рекурсивно из плоской таблицы на Workhseet
  • PHP: сохранение данных в древовидной структуре
  • Excel VBA TreeView, проходящий через дочерние узлы
  • Excel VBA - создание Treeview из набора записей
  • Экспорт дерева asp.net в excel
  • Как вы заполняете образ из формы с листа?
  • Заполнение управления TreeView с помощью иерархических данных из Excel Sheet
  • Экспорт TreeNode в Excel
  • Заполнение TreeView заголовком столбца и подзаголовком
  • Создание папок и файлов с использованием макроса excel vba и отображения с древовидным представлением и гиперссылками
  • Interesting Posts

    Гиперссылка на ячейку на другом листе в Excel

    Условная запись строки в ячейку в зависимости от пользовательского ввода

    Умножить два диапазона / массивы по ячейкам

    Как ссылаться на CodeName листа Excel из слова?

    Создание новых рабочих листов на основе значений

    Excel VBA msoScaleFromTopLeft не работает для меня

    Expression.Error Power Query EXCEL

    Используйте excel VBA для обновления основного списка на основе пользовательских входных данных

    Как скопировать строки в новый лист, если условие выполнено?

    В excel Игнорировать Просто последний символ при использовании функции соответствия

    Поиск и удаление уникальных значений внутри фразы через несколько ячеек

    Excel несколько, если аргументы

    excel, просматривая, какие «соединения для передачи данных были отключены»

    Получить последний день в месяц в AppleScript и праздничные дни в текущем месяце

    winapi найти дочерние окна title (свойства) диалогового окна веб-страницы

    Давайте будем гением компьютера.