如何在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,result:

该方法的基础是创建将每个子项链接到其父项的数组.宏然后跟踪每个孩子的链,其祖先生长一个字符串:child,parent | child,grandparent | parent | child,...排序后,这是准备保存的结果.

使用示例数据,可以组合步骤1和3,因为所有名称和行都按字母顺序排列.在一个步骤中构建名称列表并将它们链接到另一个步骤中会产生一个简单的宏,而不管序列如何.经过反思,我不确定是否需要对名称进行排序.必须对步骤5中的祖先名称列表进行排序.输出后无法对Sheet3进行排序,因为可能有三个以上的级别.

我不确定这是否算是优雅的解决方案,但它非常简单.

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

共有7个阶段:

1. 构建包含每个名称的子数组.
2. 排序数组子.我提供了一个适合演示的简单类型.如果您有足够的名称可以在互联网上提供更好的排序.
3. 构建数组Parent,使Parent(N)成为Child(N)父项的Child内的索引.
4. 通过跟随数组中的指针来构建数组ParentName从父级到父级到祖父级到...在执行此操作时,确定最大级别数.
5. 排序数组ParentName.
6. 在输出表中构建标题行.
7. 将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