求助：将逐条记录根据父子关系改为树状结构

wzsy2_mrf

不理解栈，是很难写好递归程序，更不用说将递归的改成非递归。

micch

重新学习了几天，结果还是无法彻底搞清楚递归怎么才合理；exit退出后居然还调运自身运行了个循环练习练习再练习

1. Dim d, ar, r&, c&, n&, a(9) As String
   
2. Sub tt()
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = [a1].CurrentRegion
   
5.     ReDim ar(UBound(arr), 9) '推荐人存入字典
   
6.     For i% = 2 To UBound(arr): d(arr(i, 1)) = d(arr(i, 1)) & " " & arr(i, 2): Next
   
7.     all$ = Join(d.items) & " "
   
8.     For Each w In d.keys '对每个一级推荐人递归循环
   
9.         If InStr(all, " " & w & " ") = 0 Then
   
10.             ar(n, 0) = w:       a(1) = Mid(d(w), 2)
    
11.             Call dg(a, n, 1)
    
12.         End If
    
13.     Next
    
14.     [f3].Resize(n + 1, 9) = ar
    
15.     End
    
16. End Sub
    
17. Sub dg(a, r, c)
    
18.         x = Split(a(c) & " ")(0):   ar(r, c) = x
    
19.         If d.exists(x) Then '向后递增
    
20.             a(c + 1) = Mid(d(x), 2)
    
21.             Call dg(a, r, c + 1)
    
22.         ElseIf InStr(a(c), " ") Then '最后一级
    
23.             a(c) = Replace(a(c), x & " ", "")
    
24.             Call dg(a, r + 1, c)
    
25.         Else '向前返回
    
26.             a(c - 1) = Mid(a(c - 1), InStr(a(c - 1) & " ", " ") + 1)
    
27.             If Len(a(c - 1)) Then
    
28.                 Call dg(a, r + 1, c - 1)
    
29.             Else
    
30.                 n = r + 1
    
31.                 Exit Sub '退出后，end if执行，不懂
    
32.             End If
    
33.         End If
    
34. End Sub
    

复制代码

wzsy2_mrf

              Exit Sub '退出后，end if执行，不懂
_________________________________________________
系统保留了断点，这一层退出后系统自动取出中断的上层自动执行。关键是要理解后进先出。

micch

wzsy2_mrf 发表于 2019-3-12 15:57
Exit Sub '退出后，end if执行，不懂
_________________________________________________
...

多谢指导，查了半天也没明白不能退出的原理，关键是这样根本不知道代码对错，练习好多次递归，总是不知道如何退出，只能看着代码在end if和end sub之间来回运行

blackttea1

好程序，学习下

wzsy2_mrf

wzsy2_mrf 发表于 2019-3-12 15:57
Exit Sub '退出后，end if执行，不懂
_________________________________________________
...

递归其实很简单，也就是尽量按事物的本身逻辑来写。就本就本例来说，首先当然得建立父子关系，我的代码就是用词典交父（key) 与子（item）联系了起来。做好这一步好，递归其实很简单：
sub 递归（...）
     显示 父
    if  父没有子 then exit sub
    for i=1 to 子总数
         call  递归（.....） ‘对子进行同样操作
   next
end sub
你是考虑复杂了。用递归的目的就是简化代码，而非将其复杂化、神秘化。

小花鹿

micch 发表于 2019-3-12 15:46
重新学习了几天，结果还是无法彻底搞清楚递归怎么才合理；exit退出后居然还调运自身运行了个循环练习练习再 ...

Exit Sub '退出后，end if执行，不懂
这里退出的是本层，end if执行的是上一层的

micch

小花鹿 发表于 2019-3-14 08:32
Exit Sub '退出后，end if执行，不懂
这里退出的是本层，end if执行的是上一层的

其实最开始退出我的单独写的一个if判断，不过exit sub执行后，一样是不会退出的，还是执行最后一个end if一直循环到rc归零
；所以我才改到一个if循环内；如果exit sub能直接退到主过程，r值就能带回去，但是退不回去，r继续循环到0才能退回去所以只好多加一个参数 n 来记录退出时的 r 值。

1. Dim d, ar, r&, c&, n&, a(9) As String
   
2. Sub tt()
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = [a1].CurrentRegion
   
5.     ReDim ar(UBound(arr), 9) '推荐人存入字典
   
6.     For i% = 2 To UBound(arr): d(arr(i, 1)) = d(arr(i, 1)) & " " & arr(i, 2): Next
   
7.     all$ = Join(d.items) & " "
   
8.     For Each w In d.keys '对每个一级推荐人递归循环
   
9.         If InStr(all, " " & w & " ") = 0 Then
   
10.             ar(n, 0) = w:       a(1) = Mid(d(w), 2)
    
11.             Call dg(a, n, 1)
    
12.         End If
    
13.     Next
    
14.     [f3].Resize(n + 1, 9) = ar
    
15.     End
    
16. End Sub
    
17. Sub dg(a, r, c)
    
18.     If Len(a(c)) = 0 Then
    
19.         n = r
    
20.         Exit Sub '退出后，end if执行，不懂
    
21.     End If
    
22.    
    
23.         x = Split(a(c) & " ")(0):   ar(r, c) = x
    
24.         If d.exists(x) Then '向后递增
    
25.             a(c + 1) = Mid(d(x), 2)
    
26.             Call dg(a, r, c + 1)
    
27.         ElseIf InStr(a(c), " ") Then '最后一级
    
28.             a(c) = Replace(a(c), x & " ", "")
    
29.             Call dg(a, r + 1, c)
    
30.         Else '向前返回
    
31.             a(c - 1) = Mid(a(c - 1), InStr(a(c - 1) & " ", " ") + 1)
    
32.             Call dg(a, r + 1, c - 1)
    
33.         End If
    
34. End Sub
    

复制代码

小花鹿

micch 发表于 2019-3-14 09:31
其实最开始退出我的单独写的一个if判断，不过exit sub执行后，一样是不会退出的，还是执行最后一个end if ...

每次递归都要保护现场，然后进入下一层，下一层运行完成后退回上一层，一层一层的进，一层一层的退，不可能跳跃的

micch

小花鹿 发表于 2019-3-14 10:35
每次递归都要保护现场，然后进入下一层，下一层运行完成后退回上一层，一层一层的进，一层一层的退，不可 ...

明白了，多谢，就是无论如何都要退回到进入的那个位置，所以exit并不是退到主过程，而是退出当前层的递归。