使用 VBA 进行递归树状解析

Question

我有以下输入和输出数据（Sheet1 从 1-19，Sheet2 从 21+，然后是输出） https://ethercalc.org/bzrwyz8bsail（请注意，孩子们向右对齐，而不是脚本格式的 2 个空格）

我有以下 VBA 脚本，它解析父母和项目并写入工作表 2：

Sub newlist()
    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Dim Ide As String
    Dim k As Long
    Dim kk As Long
    Dim n As Long
    Dim entity As String

    Set w1 = Sheets("Sheet1")
    Set w2 = Sheets("Sheet2")
    w2.Cells(1, 1).Value = w1.Cells(1, 8).Value
    w2.Cells(1, 2).Value = w1.Cells(1, 10).Value
    c = 0
    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, 8).Value = Ide Then
            entity= w1.Cells(i, 10).Value
            entityString = "  " & entity
            w2.Cells(kk + 1, 1).Value = entityString
            kk = kk + 1
            k = k + 1
        Else
            kk = kk + 1
            k = 3
            Ide = w1.Cells(i, 8).Value
            entity= w1.Cells(i, 10).Value
            w2.Cells(kk, 1).Value = Ide
            kk = kk + 1
            entityString = "  " & entity
            w2.Cells(kk, 1).Value = entityString
        End If
        Next
    End Sub

从输出中可以看出，自己是孩子的父母并没有写在他们的父母之下。例如，第一个爸爸的孩子应该写在根的孩子爸爸下面，名字不能重复两次。另一个例子是 Echo 的孩子应该如何在 Echo 之下，而不是被重复。

我将如何使用递归来处理这个问题？好像迭代没有效果。

Answer 1

我在递归方面真的很弱，但这里试一试。下面的输出来自Debug.Print 语句：

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

Sheet 2 上的输出带有缩进级别：

当ProcessItem 方法在For Each v In dict(name) 循环内调用自身时会发生递归：

Option Explicit
Sub newlist()
    Dim w1 As Worksheet, w2 As Worksheet
    Dim num_rows
    Dim parent As Range, parentName As String
    Dim parentRange As Range, childrenRange As Range
    Dim childCount As Long
    Dim p As Variant

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Set w1 = Sheets("Sheet6")
    num_rows = w1.Cells(Rows.Count, 1).End(xlUp).row
    'If there's no parentName column, we can't continue.
    If w1.Rows(1).Find("parentName") Is Nothing Then Exit Sub
    Set parentRange = w1.Rows(1).Find("parentName").Offset(1).Resize(num_rows - 1, 1)
    'If there's no Root level, how do we know where to start?
    If parentRange.Find("Root") Is Nothing Then Exit Sub

    For Each parent In parentRange
        If Not dict.Exists(parent.Value) Then
            childCount = Application.WorksheetFunction.CountIf(parentRange, parent.Value)
            Set childrenRange = parent.Offset(, 2).Resize(childCount, 1)
            dict.Add parent.Value, Application.Transpose(Application.Transpose(childrenRange.Value))
        End If
    Next
    Set w2 = Sheets.Add
    ' Recursive method to traverse our dictionary, beginning at Root element.
    Call ProcessItem("Root", dict, w2, 2)

    w2.Cells(1, 1).Value = w1.Cells(1, 8).Value
    w2.Cells(1, 2).Value = w1.Cells(1, 10).Value

End Sub
Private Sub ProcessItem(name As String, dict As Object, ws As Worksheet, row_num As Long, Optional indent As Long = 0)
Dim output As String, v
' add spaces to indent the output string:
output = WorksheetFunction.Rept(" ", indent) & name
Debug.Print output
' write output to the new worksheet:
ws.Cells(row_num, 1).Value = output
row_num = row_num + 1
If Not dict.Exists(name) Then
    'we're at a terminal element, a child with no children.
    Exit Sub
Else
    For Each v In dict(name)
        ' ## RECURSION ##
        Call ProcessItem(CStr(v), dict, ws, row_num, indent + 2)
    Next
End If

End Sub

跟进：

如果您还想跟踪父名称（例如“parent.child”），那么我认为您可以这样做（未经测试）：

像这样进行初始调用 - 您实际上不需要在函数调用中命名参数，但我这样标记它只是为了说明：

Call ProcessItem(parentName:="", "Root", dict, w2, 2)

那么函数需要稍微修改一下：

Private Sub ProcessItem(parentName as String, name As String, dict As Object, ws As Worksheet, row_num As Long, Optional indent As Long = 0)
Dim output As String, v
output = IIF(parentName = "", name, parentName & "." & name)
output = WorksheetFunction.Rept(" ", indent) & output
Debug.Print output
' write output to the new worksheet:
ws.Cells(row_num, 1).Value = output
row_num = row_num + 1
If Not dict.Exists(name) Then
    'we're at a terminal element, a child with no children.
    Exit Sub
Else
    For Each v In dict(name)
        ' ## RECURSION ##
        Call ProcessItem(name, CStr(v), dict, ws, row_num, indent + 2)
    Next
End If

End Sub