excel - 如何在excel中建立父子数据表？

Question

我有这种方式的数据:

Parent  |  Data
---------------
Root    | AAA  
AAA     | BBB  
AAA     | CCC  
AAA     | DDD  
BBB     | EEE  
BBB     | FFF  
CCC     | GGG  
DDD     | HHH  

需要将其转换为类似以下的时尚。这基本上需要以excel电子表格结尾。如何将上述数据转换为以下数据:

级别

1   |  2  | 3

AAA | BBB |  
AAA | BBB | EEE  
AAA | BBB | FFF  
AAA | CCC |  
AAA | CCC | GGG  
AAA | DDD |  
AAA | DDD | HHH  

Answer 1

我昨晚深夜开始并完成了下面的答案。在白天的寒冷光线下，它至少需要一些扩展。

Sheet2，源数据，在宏运行之前:



Sheet3，结果，宏运行后:



该方法的基础是创建将每个子项链接到其父项的数组。然后，宏沿着从每个 child 到它的祖先的链，生成一个字符串: child ， parent | child ，祖 parent | parent | child ，...排序后，这是准备保存的结果。

对于示例数据，步骤 1 和 3 可以合并，因为所有名称和行都按字母顺序排列。在一个步骤中构建名称列表并将它们链接到另一个步骤中可以生成一个简单的宏，而不管顺序如何。经过反射(reflection)，我不确定是否有必要进行第 2 步(对名称进行排序)。第 5 步，对祖先姓名列表进行排序是必要的。输出后无法对 Sheet3 进行排序，因为可能有超过三个级别。

我不确定这是否算作一个优雅的解决方案，但它非常简单。

我已将源数据放在工作表 Sheet2 中，然后输出到 Sheet3。

有7个阶段:

构建包含每个名称的数组 Child。

排序数组子级。我提供了一个简单的排序，足以进行演示。如果您有足够的名称需要它，则可以在 Internet 上获得更好的排序。

构建数组 Parent 使得 Parent(N) 是 Child(N) 的父级的 Child 内的索引。

按照数组 Parent 中的指针从子到父到祖 parent 构建数组 ParentName 到... 在执行此操作时，确定最大级别数。

排序数组 ParentName。

在输出表中构建标题行。

将 ParentName 复制到输出表。

我相信我已经包含了足够的注释以使代码易于理解。

Option Explicit
Sub CreateParentChildSheet()

  Dim Child() As String
  Dim ChildCrnt As String
  Dim InxChildCrnt As Long
  Dim InxChildMax As Long
  Dim InxParentCrnt As Long
  Dim LevelCrnt As Long
  Dim LevelMax As Long
  Dim Parent() As Long
  Dim ParentName() As String
  Dim ParentNameCrnt As String
  Dim ParentSplit() As String
  Dim RowCrnt As Long
  Dim RowLast As Long

  With Worksheets("Sheet2")
    RowLast = .Cells(Rows.Count, 1).End(xlUp).Row
    ' If row 1 contains column headings, if every child has one parent
    ' and the ultimate ancester is recorded as having a parent of "Root",
    ' there will be one child per row
    ReDim Child(1 To RowLast - 1)

    InxChildMax = 0
    For RowCrnt = 2 To RowLast
      ChildCrnt = .Cells(RowCrnt, 1).Value
      If LCase(ChildCrnt) <> "root" Then
        Call AddKeyToArray(Child, ChildCrnt, InxChildMax)
      End If
      ChildCrnt = .Cells(RowCrnt, 2).Value
      If LCase(ChildCrnt) <> "root" Then
        Call AddKeyToArray(Child, ChildCrnt, InxChildMax)
      End If
    Next

    ' If this is not true, one of the assumptions about the
    ' child-parent table is false
    Debug.Assert InxChildMax = UBound(Child)

    Call SimpleSort(Child)

    ' Child() now contains every child plus the root in
    ' ascending sequence.

    ' Record parent of each child
      ReDim Parent(1 To UBound(Child))
      For RowCrnt = 2 To RowLast
        If LCase(.Cells(RowCrnt, 1).Value) = "root" Then
          ' This child has no parent
          Parent(InxForKey(Child, .Cells(RowCrnt, 2).Value)) = 0
        Else
          ' Record parent for child
          Parent(InxForKey(Child, .Cells(RowCrnt, 2).Value)) = _
                           InxForKey(Child, .Cells(RowCrnt, 1).Value)
        End If
      Next

  End With

  ' Build parent chain for each child and store in ParentName
  ReDim ParentName(1 To UBound(Child))

  LevelMax = 1

  For InxChildCrnt = 1 To UBound(Child)
    ParentNameCrnt = Child(InxChildCrnt)
    InxParentCrnt = Parent(InxChildCrnt)
    LevelCrnt = 1
    Do While InxParentCrnt <> 0
      ParentNameCrnt = Child(InxParentCrnt) & "|" & ParentNameCrnt
      InxParentCrnt = Parent(InxParentCrnt)
      LevelCrnt = LevelCrnt + 1
    Loop
    ParentName(InxChildCrnt) = ParentNameCrnt
    If LevelCrnt > LevelMax Then
      LevelMax = LevelCrnt
    End If
  Next

  Call SimpleSort(ParentName)

  With Worksheets("Sheet3")
    For LevelCrnt = 1 To LevelMax
      .Cells(1, LevelCrnt) = "Level " & LevelCrnt
    Next
    ' Ignore entry 1 in ParentName() which is for the root
    For InxChildCrnt = 2 To UBound(Child)
      ParentSplit = Split(ParentName(InxChildCrnt), "|")
      For InxParentCrnt = 0 To UBound(ParentSplit)
        .Cells(InxChildCrnt, InxParentCrnt + 1).Value = _
                                                ParentSplit(InxParentCrnt)
      Next
    Next

  End With

End Sub

Sub AddKeyToArray(ByRef Tgt() As String, ByVal Key As String, _
                                                  ByRef InxTgtMax As Long)

  ' Add Key to Tgt if it is not already there.

  Dim InxTgtCrnt As Long

  For InxTgtCrnt = LBound(Tgt) To InxTgtMax
    If Tgt(InxTgtCrnt) = Key Then
      ' Key already in array
      Exit Sub
    End If
  Next
  ' If get here, Key has not been found
  InxTgtMax = InxTgtMax + 1
  If InxTgtMax <= UBound(Tgt) Then
    ' There is room for Key
    Tgt(InxTgtMax) = Key
  End If

End Sub

Function InxForKey(ByRef Tgt() As String, ByVal Key As String) As Long

  ' Return index entry for Key within Tgt

  Dim InxTgtCrnt As Long

  For InxTgtCrnt = LBound(Tgt) To UBound(Tgt)
    If Tgt(InxTgtCrnt) = Key Then
      InxForKey = InxTgtCrnt
      Exit Function
    End If
  Next

  Debug.Assert False        ' Error

End Function
Sub SimpleSort(ByRef Tgt() As String)

  ' On return, the entries in Tgt are in ascending order.

  ' This sort is adequate to demonstrate the creation of a parent-child table
  ' but much better sorts are available if you google for "vba sort array".

  Dim InxTgtCrnt As Long
  Dim TempStg As String

  InxTgtCrnt = LBound(Tgt) + 1
  Do While InxTgtCrnt <= UBound(Tgt)
    If Tgt(InxTgtCrnt - 1) > Tgt(InxTgtCrnt) Then
      ' The current entry belongs before the previous entry
      TempStg = Tgt(InxTgtCrnt - 1)
      Tgt(InxTgtCrnt - 1) = Tgt(InxTgtCrnt)
      Tgt(InxTgtCrnt) = TempStg
      ' Check the new previous enty against its previous entry if there is one.
      InxTgtCrnt = InxTgtCrnt - 1
      If InxTgtCrnt = LBound(Tgt) Then
        ' Prevous entry is start of array
        InxTgtCrnt = LBound(Tgt) + 1
      End If
    Else
      ' These entries in correct sequence
      InxTgtCrnt = InxTgtCrnt + 1
    End If
  Loop

End Sub