跟进：

Question

我有以下输入和输出数据（1-19的Sheet1，21+的Sheet2，然后输出） 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

从输出中可以看到，本身是孩子的父母不会写在父母的下面。例如，第一个爸爸的孩子应该写在Root的孩子爸爸的下面，并且名字不能重复两次。另一个例子是，回声的孩子应该如何在回声之下，而不是被重复。

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

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

使用VBA进行递归树状解析

1 个答案:

跟进：