如何使用VBA填充Excel中子节点旁边的最高父节点/根节点答案

【问题标题】：How to populate the highest parent node/ Root node next to a child node in Excel using VBA如何使用VBA填充Excel中子节点旁边的最高父节点/根节点
【发布时间】：2016-08-29 07:18:42
【问题描述】：

我是 excel 宏和 VBA 的新手，并且一直在努力解决以下问题。我在 Excel 中有以下数据集：

Parent Child

AAA   BBB
AAA   CCC
AAA   DDD
BBB   EEE
BBB   FFF
CCC   GGG
FFF   HHH
III   JJJ
JJJ   KKK
JJJ   LLL

我希望用它们各自的最高级别根节点填充子节点，以便所有子节点都有一个根级别数据/父节点映射到它们，如下所示：

Node    1st Level Node
AAA     Root
BBB     AAA
CCC     AAA
DDD     AAA
EEE     AAA
FFF     AAA
GGG     AAA
HHH     AAA
III     Root
JJJ     III
KKK     III
LLL     III

我已尝试创建一个 VB 函数来创建一棵树，但无法从那里获取它以将最后一个或最高级别的根填充到相应的子节点。

我还尝试使用诸如查找唯一子名称和回溯查找主根等逻辑但无法这样做。

VB 代码：

Sub MakeTree()

    Dim r As Integer

    For r = 1 To Range("Data").Rows.Count
        If Range("Data").Cells(r, 1) = "Root" Then
            DrawNode Range("Data").Cells(r, 2), 0, 0
        End If
    Next

End Sub

Sub DrawNode(ByRef header As String, ByRef row As Integer, ByRef depth As Integer)

    Cells(Range("Destination").row + row, Range("Destination").Column + depth) = header

    Dim r As Integer

    For r = 1 To Range("Data").Rows.Count
        If Range("Data").Cells(r, 1) = header Then

            row = row + 1
            DrawNode Range("Data").Cells(r, 2), row, depth + 1
        End If
    Next
End Sub

我怎样才能继续做同样的事情。

【问题讨论】：

假设它是一个排序列表，我会使用字典。使用子节点作为键，父节点作为值。每次迭代都会检查父值是否作为键存在于子字典中，如果存在则用该值替换该值。
我认为您在问题中输入的结果数据没有正确解释它。就像 KKK 根是 JJJ 但它显示 III ，类似地 BBB 应该是 Root 而不是 AAA。能举个合适的例子吗
嗨。我已经删除了 AAA 和 III 父根。但 KKK 词根是 III 而不是 JJJ。它需要遍历到最高级别的Node。没有父节点或父节点作为“根”的节点是最高级别。

标签： vba excel macros treeview parent-child

【解决方案1】：

假设父节点在A列，子节点在B列，下面的宏会把结果放到D列和E列

Option Explicit
Sub Root_Parent()
    Dim i, re, k
    i = 2
    While Cells(i, 1) <> ""
        Set re = Range("B:B").Find(Cells(i, 1))
        If re Is Nothing Then
            Set re = Range("D:D").Find(Cells(i, 1))
            If re Is Nothing Then
                k = k + 1
                Cells(k, 4) = Cells(i, 1)
                Cells(k, 5) = "Root"
                findchild Cells(k, 4).Value, k
            End If
        End If
        i = i + 1
    Wend
End Sub
Sub findchild(parent, ByRef k)
 Dim i, s, re
 i = 2
    While Cells(i, 2) <> ""
    s = i
        Do
            Set re = Range("B:B").Find(Cells(s, 1))
            If re Is Nothing Then
                If Cells(s, 1) = parent Then
                k = k + 1
                Cells(k, 4) = Cells(i, 2)
                Cells(k, 5) = Cells(s, 1)
                End If
                Exit Do
            Else
                s = re.Row
            End If
        Loop
        i = i + 1
    Wend
End Sub

【讨论】：