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

时间:2019-02-18 20:29:05

标签: excel vba google-sheets google-sheets-api

我将数据的格式设置为CSV,分别是“父母”,“子代”,“孙子代”等列到第n列和第m行。

  • 每个父级可以有几个子级,在相邻列中以列表的顺序排列,第一个子级在与其父级相邻的单元格中,随后的子级在此子级以下的单元格中。
  • 每个孩子可以有几个孙子,以类似的方式在相邻的列中排序,等等。

我正在寻找一个Google表格宏,该宏可以从n列和m行的此范围输出一个2列的父母和孩子之间,父母和孩子之间的关系的列表,依此类推,从ID查找表中获取。

  • 所需输出示例:

    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 :(得分:-1)

通常的想法是看每个孩子,首先向左看,然后找到一个孩子,然后找到它的父母。

您可以放置​​此子项和函数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是目标表的第一个单元格。

然后,您将在自己的子程序或函数中按以下方式调用子程序:

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并运行它。