[已解决]任意数组成的8码全部组合

mmc998

Book8码.rar (6.45 KB, 下载次数: 14)

2016-12-16 19:16 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

雨吧

2016-12-17 13:58

1. Sub GetCombin_dg()
   
2.     Dim tms#
   
3.     tms = Timer
   
4.     m = [a1].End(2).Column: sj = [a1].Resize(, m)
   
5.     n = 8: w = " "
   
6.     [a3].CurrentRegion = ""
   
7.     ReDim jg(Application.Combin(23, 8), 7)
   
8.     k = 0: Call dgQZH("", 0, 0)
   
9.     [a3].Resize(k, 8) = jg
   
10.     MsgBox "组合数：" & k & vbCrLf & "用时：" & Format(Timer - tms, "0.000s")
    
11. End Sub
    
12. Sub dgQZH(r$, i&, t&)
    
13.     Dim j&, x%, ar
    
14.     If t = n Then
    
15.         ar = Split(r)
    
16.         For x = 1 To 8
    
17.             jg(k, x - 1) = ar(x)
    
18.         Next
    
19.         k = k + 1: Exit Sub
    
20.     End If
    
21.     For j = i + 1 To m
    
22.         Call dgQZH(r & w & sj(1, j), j, t + 1)
    
23.     Next
    
24. End Sub

复制代码

Book8码.rar (19.56 KB, 下载次数: 47)

2016-12-17 13:58 上传

点击文件名下载附件

跳转到最佳答案楼层

小宝潘拯

2003版显示不了这么多行，442452421

雨吧

1. Sub GetCombin_dg()
   
2.     Dim tms#
   
3.     tms = Timer
   
4.     m = [a1].End(2).Column: sj = [a1].Resize(, m)
   
5.     n = 8: w = " "
   
6.     [a3].CurrentRegion = ""
   
7.     ReDim jg(Application.Combin(23, 8), 7)
   
8.     k = 0: Call dgQZH("", 0, 0)
   
9.     [a3].Resize(k, 8) = jg
   
10.     MsgBox "组合数：" & k & vbCrLf & "用时：" & Format(Timer - tms, "0.000s")
    
11. End Sub
    
12. Sub dgQZH(r$, i&, t&)
    
13.     Dim j&, x%, ar
    
14.     If t = n Then
    
15.         ar = Split(r)
    
16.         For x = 1 To 8
    
17.             jg(k, x - 1) = ar(x)
    
18.         Next
    
19.         k = k + 1: Exit Sub
    
20.     End If
    
21.     For j = i + 1 To m
    
22.         Call dgQZH(r & w & sj(1, j), j, t + 1)
    
23.     Next
    
24. End Sub

复制代码

Book8码.rar (19.56 KB, 下载次数: 47)

2016-12-17 13:58 上传

点击文件名下载附件