后裔统计问题分享与解答（递归函数），大家有更好的办法吗？

简小白

看到论坛上面分享了一个后裔统计问题，看着很简单，实操起来确是有点难度，使用普通公式或者函数很难实现，借助VBA倒是可以解决想看看大家有没有更好的解决办法喃

cnmlgb9998

这里面的 VBA 代码，是我2018年时 学VBA 那阵子，自己写的。没有用递归，用的类似于双循环。代码，是我原创。谢谢！

cnmlgb9998

不过，四年没碰VBA 了，基本语句，我都忘光了。

贴上我的原生代码。残念。。。。。。

1. Sub test()
   
2. Set dic = CreateObject("scripting.dictionary")
   
3. arr = Range("A2:C" & Cells(Rows.Count, 1).End(xlUp).Row)
   
4. brr = Range("E2:E11")
   
5. Dim drr()
   
6. ReDim grr(1 To UBound(brr), 1 To 2)
   
7. For i = 1 To UBound(arr)
   
8.     dm = arr(i, 1)
   
9.     xb = arr(i, 2)
   
10.     en = arr(i, 3)
    
11.     dic(dm) = IIf(dic(dm) = "", en & "," & xb, dic(dm) & "/" & en & "," & xb)
    
12. Next
    
13.    
    
14. For Each br In brr
    
15.     Do
    
16.         If dic.exists(br) Then
    
17.             crr = Split(dic(br), "/")
    
18.             
    
19.             For Each cr In crr
    
20.                 If Split(cr, ",")(1) = "儿子" Then
    
21.                 male = male + 1
    
22.                
    
23.                 Else
    
24.                     female = female + 1
    
25.                     
    
26.                 End If
    
27.                 n = n + 1
    
28.                 ReDim Preserve drr(1 To n)
    
29.                 drr(n) = Split(cr, ",")(0)
    
30.             Next
    
31.            
    
32.         End If
    
33.      
    
34.         m = m + 1
    
35.         If m <= n Then
    
36.             br = drr(m)
    
37.         End If
    
38.         
    
39.     Loop While m <= n
    
40.     s = s + 1
    
41.     grr(s, 1) = male
    
42.     grr(s, 2) = female
    
43.     male = 0
    
44.     female = 0
    
45.     n = 0
    
46.     m = 0
    
47.    
    
48.    
    
49.         
    
50. Next
    
51. [F2:G11].ClearContents
    
52. [F2].Resize(UBound(grr), 2) = grr
    
53. 
    
54.    
    
55. End Sub
    
56. 
    

复制代码

ynzsvt

1. Function DescendantsCount(name As String, Gender As String) As Integer
   
2. Dim i As Long
   
3. Dim count As Integer
   
4. count = 0
   
5. For i = 1 To Cells(Rows.count, "A").End(xlUp).Row
   
6.   If Cells(i, "A").Value = name Then
   
7.    If Cells(i, "B").Value = Gender Then
   
8.     count = count + 1 + DescendantsCount(Cells(i, "C").Value, Gender)
   
9.    Else
   
10.     count = count + 0 + DescendantsCount(Cells(i, "C").Value, Gender)
    
11.    End If
    
12.   End If
    
13. Next i
    
14. DescendantsCount = count
    
15. End Function

复制代码

今铭昔

今铭昔

cnmlgb9998 发表于 2024-7-18 19:05
这里面的 VBA 代码，是我2018年时 学VBA 那阵子，自己写的。没有用递归，用的类似于双循环。代码，是我原创 ...

ynzsvt

cnmlgb9998 发表于 2024-7-18 19:05
这里面的 VBA 代码，是我2018年时 学VBA 那阵子，自己写的。没有用递归，用的类似于双循环。代码，是我原创 ...

估计记错了，又是递归，又是含错误。

简小白

今铭昔 发表于 2024-7-18 20:10

这位朋友很不错哦，&#128077;一个！

飞天篮球猪

cnmlgb9998

ynzsvt 发表于 2024-7-18 20:13
估计记错了，又是递归，又是含错误。

我这代码里，哪有递归？？？？ 你指出来，OK？？？？？？