[已解决]怎样用递归法显示出所有组合数问题

hongshanyulong0

怎样用递归法显示出所有组合数问题.zip (9.33 KB, 下载次数: 88)

2013-6-28 09:15 上传

点击文件名下载附件 在B4:OG4区域中共有372个数据，b4:m4为第1组，n4:y4为第2组，z4:ak4为第3组，以下依次每12个单元格为一组数，共有31组。想通过vba应用递归法自b6单元格开始显示出任意6组数据的所有组合情况，请你帮助解决一下。

最佳答案

月排行榜 / 总排行榜

香川群子

2013-7-1 16:48

呵呵，递归也改用数组a()记录组合状态以后，速度也提高到7秒以内……

1. Dim sj%(), jg%(), l%, m%, n%, k&
   
2. Sub 递归组合()
   
3.     tms = Timer
   
4.     m = 31: n = 6: l = 12: k = 0
   
5.     ReDim sj%(1 To m, 1 To l)
   
6.     For i = 1 To m
   
7.         For j = 1 To l
   
8.             k = k + 1
   
9.             sj(i, j) = k
   
10.         Next
    
11.     Next
    
12.    
    
13.     ReDim a&(n - 1)
    
14.     k = WorksheetFunction.Combin(m, n)
    
15.     ReDim jg%(1 To k, 1 To n * l)
    
16.     k = 0: Call dgZH(a, 0, 0)
    
17.     MsgBox Format(Timer - tms, "0.000s"): tms = Timer
    
18.     'Erase jg: Exit Sub '不输出结果直接停止
    
19. 
    
20.    '应楼主要求，改为从B9单元格开始输出结果
    
21.     [b9].Resize(Rows.Count -9, n * l) = ""
    
22.     [b9].Resize(k, n * l) = jg
    
23.     MsgBox Format(Timer - tms, "0.000s")
    
24. End Sub
    
25. Sub dgZH(a&(), i%, t%)
    
26.     Dim j%, ii%, jj%
    
27.     For j = i + 1 To m
    
28.         If t + 1 < n Then
    
29.             a(t) = j
    
30.             Call dgZH(a(), j, t + 1)
    
31.         Else
    
32.             k = k + 1
    
33.             a(t) = j
    
34.             For ii = 0 To n - 1
    
35.                 For jj = 1 To l
    
36.                     jg(k, ii * l + jj) = sj(a(ii), jj)
    
37.                 Next
    
38.             Next
    
39.         End If
    
40.     Next
    
41. End Sub
    

复制代码

应楼主要求，改为从B9单元格开始输出结果

跳转到最佳答案楼层

wcymiss

排列组合不需要递归。论坛有相关讨论帖。自己搜下吧。

hongshanyulong0

求助呀！

hongshanyulong0

再发求助请求。

香川群子

递归可以有。

如果就是 1-372 构成的31组12位数字进行31取6组合=736281组解的话，
用下面递归代码计算只要 30秒以内。
但73万多行结果输出到工作表就可能耗费大量时间了。→ 或许会死机？我没有试。

1. Dim sj%(), jg%(), l%, m%, n%, k&
   
2. Sub 組合()
   
3.     tms = Timer
   
4.     m = 31: n = 6: l = 12
   
5.     ReDim sj%(1 To m, 1 To l)
   
6.     For i = 1 To m
   
7.         For j = 1 To l
   
8.             k = k + 1
   
9.             sj(i, j) = k
   
10.         Next
    
11.     Next
    
12.    
    
13.     k = WorksheetFunction.Combin(m, n)
    
14.     ReDim jg%(1 To k, 1 To n * l)
    
15.     k = 0: Call dgZH("", 0, 1)
    
16.    
    
17.     MsgBox Format(Timer - tms, "0.000s ") & k: tms = Timer
    
18.     [a1].Resize(Rows.Count, n * l) = ""
    
19.     [a1].Resize(k, n * l) = jg
    
20.     MsgBox Format(Timer - tms, "0.000s ")
    
21. End Sub
    
22. Sub dgZH(s$, i%, t%)
    
23.     Dim j%, ii%, jj%
    
24.     For j = i + 1 To m
    
25.         If t < n Then
    
26.             Call dgZH(s & j & ",", j, t + 1)
    
27.         Else
    
28.             k = k + 1
    
29.             p = Split(s & j, ",")
    
30.             For ii = 0 To UBound(p)
    
31.                 For jj = 1 To l
    
32.                     jg(k, ii * l + jj) = sj(p(ii), jj)
    
33.                 Next
    
34.             Next
    
35.         End If
    
36.     Next
    
37. '    Application.StatusBar = s
    
38. End Sub
    

复制代码

香川群子

wcymiss 发表于 2013-6-28 10:37
排列组合不需要递归。论坛有相关讨论帖。自己搜下吧。

吴姐你好！


经过改进，目前EXCEL VBA代码中，我的Do……Loop循环计算组合的代码速度效率最好！

1. Sub Combin_kagawa(m&, n&)
   
2. tms = Timer
   
3. Dim i&, j&, l1&
   
4. ReDim a&(1 To n)
   
5. If n = m Then For j = 2 To n - 1: a(j) = j: Next
   
6. 
   
7. a(n) = m: a(1) = 0: j = 1: l1 = m - n + 1
   
8. Do
   
9.   If a(n) = m Then
   
10.     a(j) = a(j) + 1
    
11.     If a(j) < m - n + j Then
    
12.       For j = j To n - 1
    
13.         a(j + 1) = a(j) + 1
    
14.       Next
    
15.     End If
    
16.     j = j - 1
    
17.   Else
    
18.     a(n) = a(n) + 1
    
19.   End If
    
20.   i = i + 1
    
21. Loop While a(1) < l1 'm - n + 1
    
22. Cells(n, 6) = Format(Timer - tms, " 0.000s") & " kagawa Combin(" & m & "," & n & ")= " & Application.Combin(m, n)
    
23. End Sub
    

复制代码

香川群子

呵呵，用我香川发明的Do……Loop循环计算组合，只要5秒以内啊！
比递归快了5-6倍。

1. Sub Combin_kagawa()
   
2.     tms = Timer
   
3.     Dim i&, j&, l1&, ii&, jj&, l&, m&, n&, t&
   
4.     m = 31: n = 6: l = 12
   
5.    
   
6.     ReDim sj%(1 To m, 1 To l)
   
7.     For i = 1 To m
   
8.         For j = 1 To l
   
9.             k = k + 1
   
10.             sj(i, j) = k
    
11.         Next
    
12.     Next
    
13.    
    
14.     i = WorksheetFunction.Combin(m, n)
    
15.     ReDim jg%(1 To i, 1 To n * l)
    
16.    
    
17.     ReDim a&(1 To n)
    
18.     a(n) = m: a(1) = 0
    
19.     i = 0: j = 1: l1 = m - n + 1
    
20.     Do
    
21.         If a(n) = m Then
    
22.             a(j) = a(j) + 1
    
23.             If a(j) < m - n + j Then
    
24.                 For j = j To n - 1
    
25.                     a(j + 1) = a(j) + 1
    
26.                 Next
    
27.             End If
    
28.             j = j - 1
    
29.         Else
    
30.             a(n) = a(n) + 1
    
31.         End If
    
32.         '以上为生成各种组合变化
    
33.         i = i + 1 '下面为输出组合结果部分
    
34.         For ii = 0 To n - 1
    
35.             For jj = 1 To l
    
36.                 jg(i, ii * l + jj) = sj(a(ii + 1), jj)
    
37.             Next
    
38.         Next
    
39.     Loop While a(1) < l1 'm - n + 1
    
40.    
    
41.     MsgBox Format(Timer - tms, "0.000s"): tms = Timer
    
42.     'Erase jg: Exit Sub '不输出结果就结束
    
43. 
    
44.     '应楼主要求，改为从B9单元格开始输出结果
    
45.     [b9].Resize(Rows.Count - 9, n * l) = ""
    
46.     [b9].Resize(k, n * l) = jg
    
47.     MsgBox Format(Timer - tms, "0.000s")
    
48. End Sub
    
49. 
    

复制代码

应楼主要求，改为从B9单元格开始输出结果

香川群子

其实不包含输出部分，仅仅组合计算Combin(31,6)=736281时，
香川的Do……Loop循环只要0.2秒就计算完成了。

递归的时间是0.3秒……可是因为输出结果时使用了split方法，所以慢了很多。
或许改为用数组a()存储状态会好很多。

香川群子

呵呵，递归也改用数组a()记录组合状态以后，速度也提高到7秒以内……

1. Dim sj%(), jg%(), l%, m%, n%, k&
   
2. Sub 递归组合()
   
3.     tms = Timer
   
4.     m = 31: n = 6: l = 12: k = 0
   
5.     ReDim sj%(1 To m, 1 To l)
   
6.     For i = 1 To m
   
7.         For j = 1 To l
   
8.             k = k + 1
   
9.             sj(i, j) = k
   
10.         Next
    
11.     Next
    
12.    
    
13.     ReDim a&(n - 1)
    
14.     k = WorksheetFunction.Combin(m, n)
    
15.     ReDim jg%(1 To k, 1 To n * l)
    
16.     k = 0: Call dgZH(a, 0, 0)
    
17.     MsgBox Format(Timer - tms, "0.000s"): tms = Timer
    
18.     'Erase jg: Exit Sub '不输出结果直接停止
    
19. 
    
20.    '应楼主要求，改为从B9单元格开始输出结果
    
21.     [b9].Resize(Rows.Count -9, n * l) = ""
    
22.     [b9].Resize(k, n * l) = jg
    
23.     MsgBox Format(Timer - tms, "0.000s")
    
24. End Sub
    
25. Sub dgZH(a&(), i%, t%)
    
26.     Dim j%, ii%, jj%
    
27.     For j = i + 1 To m
    
28.         If t + 1 < n Then
    
29.             a(t) = j
    
30.             Call dgZH(a(), j, t + 1)
    
31.         Else
    
32.             k = k + 1
    
33.             a(t) = j
    
34.             For ii = 0 To n - 1
    
35.                 For jj = 1 To l
    
36.                     jg(k, ii * l + jj) = sj(a(ii), jj)
    
37.                 Next
    
38.             Next
    
39.         End If
    
40.     Next
    
41. End Sub
    

复制代码

应楼主要求，改为从B9单元格开始输出结果

hongshanyulong0

香川群子 发表于 2013-7-1 16:48
呵呵，递归也改用数组a()记录组合状态以后，速度也提高到7秒以内……

谢谢群子老师的帮助！编写vba代码又给论坛里的朋友们总结出更快捷、简便的方法，认真学习、测试过程中还希望通过这道题能像论坛中的高手学习更多。再次谢谢！