使用带有VBA的父子ID生成树状结构

Question

我有以下四列，需要在“ item”上进行迭代：

parentID    parent  itemID  item
398735  Papa    398713  Alpha
398735  Papa    399270  Bravo
398735  Papa    399822  Charlie
398731  Lima    398732  Delta
398731  Lima    398733  Echo
398733  Echo    66359   Foxtrot
398733  Echo    66360   Golf
398733  Echo    66361   Hotel
398733  Echo    66362   India
398733  Echo    66363   Juliett
398733  Echo    66364   Kilo
398730  Root    66281   Mike
398730  Root    66283   November
398730  Root    398731  Lima
398730  Root    398734  Oscar
398734  Oscar   398735  Papa
398734  Oscar   66281   Quebec

我想生成一个动态层次结构（树状结构），如下所示：

Mike
November
Lima
    Delta
    Echo
        Foxtrot
        Golf
        Hotel
        India
        Juliett
        Kilo
Oscar
    Papa
        Alpha
        Bravo
        Charlie
    Quebec

例如，如果这是在Python中，则通过遍历我的项目，查看其是否为父项（如果不是，则为根），并使用字典来存储所有这些信息来创建层次结构将非常容易通过遍历字典在Excel工作表上构建此结构。但是，出于这个宏的目的，我什至不知道如何进行简单的列查找，更不用说使用字典了。

我的理论是：

  

1）首先以某种方式遍历四个“根”，然后将它们存储为dict1中具有空值的键。

     

2）对于每个根，将其在dict1中的值更新为直接子代数组。

     

3）然后，为每个根的每个子代创建另一个词典（dict2），其中所有键都是根子代。

     

4）遍历dict2键并将每个键值设置为子级数组。

     

5）遍历dict1，编写所有内容，并为进一步的孩子使用dict2。

可以在VBA中优雅地实现吗？

Answer 1

我很难确切地了解您想要什么，但是我认为应该这样做。

Sub newlist()
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
w2.Cells(1, 1).Value = w1.Cells(1, 1).Value
w2.Cells(1, 2).Value = w1.Cells(1, 2).Value
Ide = Cells(1, 1).Value
w1.Activate
n = Cells(Rows.Count, 1).End(xlUp).Row
k = 3
kk = 1
For i = 2 To n
If w1.Cells(i, 1).Value = Ide Then
w2.Cells(kk, k).Value = w1.Cells(i, 2).Value
k = k + 1
Else
kk = kk + 1
k = 3
Ide = w1.Cells(i, 1).Value
w2.Cells(kk, 1).Value = Ide
w2.Cells(kk, 2).Value = w1.Cells(i, 2).Value
End If
Next
End Sub

之前：

之后：

Answer 2

好吧，我对原始代码做了一些小的调整。试试看，看看你的生活如何。

Sub newlist()
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
w2.Cells(1, 1).Value = w1.Cells(1, 1).Value
w2.Cells(1, 2).Value = w1.Cells(1, 2).Value
Ide = Cells(1, 1).Value
w1.Activate
n = Cells(Rows.Count, 1).End(xlUp).Row
k = 3
kk = 1
For i = 2 To n
If w1.Cells(i, 1).Value = Ide Then
w2.Cells(kk + 1, 2).Value = w1.Cells(i, 2).Value
kk = kk + 1
k = k + 1
Else
kk = kk + 1
k = 3
Ide = w1.Cells(i, 1).Value
w2.Cells(kk, 1).Value = Ide
w2.Cells(kk, 2).Value = w1.Cells(i, 2).Value
End If
Next
End Sub

之前：

之后：