Простой макрос для преобразования диапазона данных генеалогической иерархии в список данных - PullRequest
Новая
       8

Простой макрос для преобразования диапазона данных генеалогической иерархии в список данных

0 голосов
/ 18 февраля 2019

У меня есть данные, отформатированные в формате CSV в виде столбцов «Родители, дети, внуки» и т. Д. В столбце n и строке m.

  • У каждого родителя может быть несколько детей, упорядоченных в виде списка всмежный столбец, с первым дочерним элементом в ячейке, смежной с его родителем, и последующими дочерними элементами в ячейках ниже этого.
  • Каждый ребенок может иметь несколько внуков, упорядоченных в соседнем столбце аналогичным образом и т. Д.

Я ищу макрос листов Google, который может выводить данные из этого диапазонаn столбцов и m строк - список из 2 столбцов отношений между каждым родителем и дочерним элементом, каждым дочерним элементом и внуком и т. д., как отдельные идентификаторы, извлеченные из таблицы поиска идентификаторов.

  • Примержелаемого результата: 

    Parent1_ID;Child1_ID        
Parent1_ID;Child2_ID        
Parent1_ID;Child3_ID        
Child1_ID;Grandchild1_ID
etc.

Более точный пример текущих и желаемых выходных данных см. в примерах данных на странице Google:

https://docs.google.com/spreadsheets/d/1Y6MvJcAjHlQFl-JukLuXvhDzXup2cCU_QU4bZt6JZrM/edit?usp=sharing

Любая помощь приветствуется!

1 Ответ

0 голосов
/ 19 февраля 2019

Общая идея заключается в том, чтобы посмотреть на каждого потомка и найти его родителя, сначала посмотрев влево, а затем вверх, если ничего не найдено.

Вы можете поместить этот саб и функцию в модуль: 

Public Sub DoTheHierarchyThing(ByVal prngSource As Excel.Range, ByVal prngDestinationTopLeftCell As Excel.Range)
    Dim rngChildren As Excel.Range
    Dim rngChild As Excel.Range
    Dim rngParent As Excel.Range

    'Find the children in the source zone, excluding its first column.
    Set rngChildren = prngSource.Resize(prngSource.Rows.Count, prngSource.Columns.Count - 1).Offset(0, 1).SpecialCells(xlCellTypeConstants)

    'Scan the children.
    'First look on the left for a parent, then up if none is found.
    For Each rngChild In rngChildren.Cells
        Set rngParent = rngChild.Offset(0, -1)
        If IsEmpty(rngParent.Value2) Then
            'Look up.
            Set rngParent = rngParent.End(xlUp)
        End If

        prngDestinationTopLeftCell.Value2 = GetTitleSuffix(rngParent.Value2)
        prngDestinationTopLeftCell.Offset(0, 1).Value2 = GetTitleSuffix(rngChild.Value2)

        Set prngDestinationTopLeftCell = prngDestinationTopLeftCell.Offset(1)
    Next
End Sub

Private Function GetTitleSuffix(ByVal psTitle As String) As String
    GetTitleSuffix = Trim$(Replace(psTitle, "Title ", "", Compare:=vbTextCompare))
End Function

, где prngSource - диапазон, охватывающий ваши заголовки, а prngDestinationTopLeftCell - первая ячейка таблицы назначения.

Тогда вы бы в своем собственномподпрограмма или функция, вызовите подпрограмму следующим образом: 

Public Sub MySub
    'Your code, if any...

    'Call the sub with appropriate parameters:
    DoTheHierarchyThing Sheet1.Range("A1:E53"), Sheet1.Range("A55")

    'Your code, if any...
End Sub

Наконец, из меню «Вид» в макросах Excel вы должны выбрать MySub в списке и запустить его.

...