用于将族谱层次数据的范围转换为列表数据的简单宏

Posted 2021-03-26

我有数据格式化为CSV格式的父母，子女，孙子等列到第n列和第m行。

• 每个Parent可以有几个子节点，在相邻列中作为列表排序，其中第一个子节点与其父节点相邻，单元格中的后续子节点位于该节点之下。
• 每个孩子可以有几个孙子，以相似的方式在相邻的栏目中排序等。

我正在寻找一个谷歌表格宏，可以从这个n列和m行的范围输出每个父母和孩子，每个孩子和孙子之间的两列关系列表，依此类推，作为从ID中提取的个人ID查找表。

• 期望输出的示例： Parent1_ID;Child1_ID Parent1_ID;Child2_ID Parent1_ID;Child3_ID Child1_ID;Grandchild1_ID etc.

请参阅示例数据google sheet以获取当前和所需输出数据的更准确示例：

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

任何帮助是极大的赞赏！

答案

一般的想法是看看每个孩子，并通过首先向左看，找到它的父母，如果没有找到，则找到它。

你可以把这个子和函数in a module：

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是目的地表的第一个单元格。

然后，您将在您自己的子或函数中调用sub，如下所示：

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的View菜单，Macros中，您将在列表中选择MySub并运行它。