返回 VBA 中的所有终端子级

Question

我有一棵树定义为两列，父列和子列。

例如，表格可能如下：

家长	孩子
A	A1
A	A2
A1	A1.1
A1	A1.2
A1	A1.3
A2	A2.1
A1.2	A1.2.1
A1.2	A1.2.2

给定一个节点，我需要该节点的所有终端子节点。在上面的示例中，给定节点 A1，我需要列表 {A1.1, A1.2.1, A1.2.2, A1.3}。

我尝试过以下代码。我迭代父列以查找匹配项。如果匹配，我会递归地查找子节点。

我认为它很接近，但它给了我中间子节点以及指定的节点本身。我可以很容易地过滤掉指定的节点（甚至发布 VBA 过程，所以我不担心这一点）。然而，我正在努力考虑删除中间子节点。感谢任何帮助。

Public Function GetChildren(CheckString As String, CheckColumn As Range) As Variant
    Dim temp As Variant
    Dim Cell As Range
    
    For Each Cell In CheckColumn
        Set temp = Cell.Find(CheckString)
        If (Not temp Is Nothing) Then
            Call GetChildren(Cell.Offset(0, 1).Value2, CheckColumn)
        End If
    Next
    
    Debug.Print (CheckString)
        
End Function


Sub Main()

Dim CheckColumn As Range
Dim CheckTable As String
Dim CheckString As String

CheckString = "E2270"
Set CheckColumn = ThisWorkbook.Sheets("Map").Range("CheckRange")

Call GetChildren(CheckString, CheckColumn)

End Sub

Answer 1

• 使用Dict对象存储父子关系

Option Explicit

Sub GetTerminalNodes()
    Dim i As Long, objDic As Object
    Dim arrData, rngData As Range
    Dim sParent As String, sChild As String
    Const START_NODE = "A1"  ' modify as needed
    ' load data into an array
    Set rngData = ActiveSheet.Range("A1").CurrentRegion
    arrData = rngData.Value
    Set objDic = CreateObject("scripting.dictionary")
    ' load parent-child into Dict
    For i = LBound(arrData) To UBound(arrData)
        sParent = arrData(i, 1): sChild = arrData(i, 2)
        If Not objDic.exists(sParent) Then
            Set objDic(sParent) = CreateObject("scripting.dictionary")
        End If
        objDic(sParent)(sChild) = ""
    Next i
    Dim oCol As New Collection, vItem
    ' get the terminal nodes
    GetNodes objDic, START_NODE, oCol
    ' write to Immediate Window
    If oCol.Count > 0 Then
        For Each vItem In oCol
            Debug.Print vItem
        Next
    End If
End Sub
' recursive get the child node
Sub GetNodes(oDic As Object, ByVal sPar As String, ByRef oCol As Collection)
    Dim vKey
    If oDic.exists(sPar) Then
        For Each vKey In oDic(sPar)
           GetNodes oDic, vKey, oCol
        Next
    Else
        oCol.Add sPar
    End If
End Sub

输出：

A1 0.1
A1.2.1
A1.2.2
A1 0.3