vba - 使用 VBA 进行递归树状解析

Question

我有以下输入和输出数据(Sheet1 来自 1-19，Sheet2 来自 21+，然后是输出)
https://ethercalc.org/bzrwyz8bsail (请注意， children 向右对齐，而不是有 2 个空格，这是脚本的格式)

我有以下 VBA 脚本，它解析 parent 和项目并写入工作表 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

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

我将如何使用递归来处理这个问题？似乎迭代无效。

Answer 1

我对递归真的很弱，但这是一个尝试。下面的输出来自 Debug.Print陈述:

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

以及带有缩进级别的工作表 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