[已解决]求组合

zhaongxa

用11个A字母组合成2个A字母的组合,3个A字母的组合,到11个A字母的组合,A与A是用"+" 或 "-" 相连例;
A+A
A-A
A+A+A
A+A-A
A-A+A
A-A-A  等等到第11位的组合,再把末位是 "-"相连的组合去掉(例A-A,  A+A-A,  A-A-A,等)  
   直接给结果也行

最佳答案

月排行榜 / 总排行榜

香川群子

2012-11-7 13:11

用递归方法写了个代码……过程中重复项太多，最后用字典方法排除重复做好了。

结果正确，但代码冗余太多。

可以考虑用循环做，估计代码效率会高一点。

跳转到最佳答案楼层

那么的帅

结果显示在哪里？

zhaongxa

那么的帅 发表于 2012-5-14 18:26
结果显示在哪里？

放在工作表里就可以

zhaongxa

zhaongxa 发表于 2012-5-14 18:31
放在工作表里就可以

自己顶一下在线等

香川群子

用递归方法写了个代码……过程中重复项太多，最后用字典方法排除重复做好了。

结果正确，但代码冗余太多。

可以考虑用循环做，估计代码效率会高一点。

香川群子

1. 
   
2. Dim d, m%
   
3. Sub kagawa()
   
4.     m = [a1] 'A1单元格中写入要排列的字母A的个数。
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Call dgH("+", "A+A", 0, 0)
   
7.     MsgBox d.Count & vbCr & Format(Timer - tms, "0.000s")
   
8. 
   
9.     '以上计算完毕，下面是输出结果到工作表
   
10.     [c:h] = ""
    
11.     [c1].Resize(d.Count) = Application.Transpose(d.items)
    
12.     [d1].Resize(d.Count) = Application.Transpose(d.keys)
    
13.     [c1].CurrentRegion.Sort [c1], 1, [d1], , 1, , 2
    
14. End Sub
    
15. Sub dgH(r$, s$, i%, t%) '递归计算
    
16.     Dim j%
    
17.     If t > m - 2 Then Exit Sub
    
18.     d(s) = t + 2
    
19.    
    
20.     For j = i + 1 To m - 2
    
21.         Call dgH("+" & r, "A+" & s, j, t + 1)
    
22.         Call dgH("-" & r, "A-" & s, j, t + 1)
    
23.     Next j
    
24.    
    
25. End Sub
    

复制代码

爱疯

香川群子 发表于 2012-11-7 13:11
用递归方法写了个代码……过程中重复项太多，最后用字典方法排除重复做好了。

结果正确，但代码冗余太多 ...

估计楼主忘记结贴了。
群子老师的贴超有学习价值，希望常来转转啊{:021:}

hwc2ycy

膜拜。

wcymiss

写个不用递归不用字典的：

1. Sub 组合()
   
2. '按A的个数分组
   
3. 'A的个数为2时组内元素为1个，值为"A+A"
   
4. 'A的个数为3时，把上组内的元素前面分别添加"A+"和"A-"，组成2个元素，为"A+A+A"和"A-A+A"
   
5. 'A的个数为4时，把上组内的元素前面分别添加"A+"和"A-"，组成2*2个元素
   
6.     '为"A+A+A+A"、"A+A-A+A"、"A-A+A+A"、"A-A-A+A"
   
7. 'A的个数为4时，把上组内的元素前面分别添加"A+"和"A-"，组成2*4个元素
   
8. '……
   
9. 'A的个数为n时，把上组内元素前面分别添加"A+"和"A-"，组成2^(n-2)个元素
   
10.     Dim p() As String, x As Integer, i As Integer, j As Integer
    
11.     Dim m As Integer, n As Integer, t
    
12.     t = Timer
    
13.     n = [a1].Value
    
14.     ReDim p(1 To 2 ^ (n - 1) - 1, 1 To 1)
    
15.     x = 1 '组内元素个数
    
16.     m = 1 '组内最后元素在总组合的位置
    
17.     p(1, 1) = "A+A" 'A的个数为2的一组，直接赋值
    
18.     For i = 3 To n 'A的个数从3到n
    
19.         For j = 1 To x '上组元素有x个，本组起始位置为m+1
    
20.             p(m + j, 1) = "A+" & p(m - j + 1, 1)
    
21.             p(m + j + x, 1) = "A-" & p(m - j + 1, 1)
    
22.         Next
    
23.         x = x * 2 '本组元素个数
    
24.         m = m + x '本组最后位置
    
25.     Next
    
26.     MsgBox Timer - t
    
27.     Range("e:e").ClearContents
    
28.     Range("e1").Resize(UBound(p), 1) = p
    
29. End Sub

复制代码

香川群子

还是用递归。

递归-1,用字典方法记录。

递归-2,用数组方法记录，并能返回+-符号结果。


过程中已经排除了重复，效率有所提高。

不过，和9楼直接数组循环方式比，还是慢了不少……这个是递归的短板。

1. Dim jg(), d, m%, k&
   
2. Sub kagawa1()
   
3.     tms = Timer
   
4.     m = [a1]
   
5.     [c:d] = ""
   
6.    
   
7.     Set d = CreateObject("Scripting.Dictionary")
   
8.    
   
9.     Call dgH1("A+A", 0, 0)
   
10.    
    
11.     [c1].Resize(d.Count) = Application.Transpose(d.items)
    
12.     [d1].Resize(d.Count) = Application.Transpose(d.keys)
    
13.     [c1].CurrentRegion.Sort [c1], 1, [d1], , 1, , 2
    
14.     MsgBox "字典方法结果： " & d.Count & vbCr & Format(Timer - tms, "0.000s")
    
15.    
    
16. End Sub
    
17. Sub dgH1(s$, i%, t%)
    
18.     Dim j%
    
19.    
    
20.     d(s) = t + 2
    
21.    
    
22.     For j = i + 1 To m - 2
    
23.         If j <= t + 1 Then Call dgH1("A+" & s, j, t + 1)
    
24.         If j <= t + 1 Then Call dgH1("A-" & s, j, t + 1)
    
25.     Next j
    
26.    
    
27. End Sub
    
28. Sub kagawa2()
    
29.     tms = Timer
    
30.     m = [a1]
    
31.     [f:h] = ""
    
32.    
    
33.     ReDim jg(2 ^ (m - 1) - 1, 2)
    
34.    
    
35.     k = 0
    
36.    
    
37.     Call dgH2("+", "A+A", 0, 0)
    
38.    
    
39.    
    
40.     [f1].Resize(k, 3) = jg
    
41.     [f1].CurrentRegion.Sort [f1], 1, [h1], , 1, , 2
    
42.     MsgBox "数组记录递归方法结果： " & k & vbCr & Format(Timer - tms, "0.000s")
    
43.    
    
44. End Sub
    
45. Sub dgH2(r$, s$, i%, t%)
    
46.     Dim j%
    
47.    
    
48.     jg(k, 0) = t + 2: jg(k, 1) = r: jg(k, 2) = s: k = k + 1
    
49.    
    
50.     For j = i + 1 To m - 2
    
51.         If j <= t + 1 Then Call dgH2("+" & r, "A+" & s, j, t + 1)
    
52.         If j <= t + 1 Then Call dgH2("-" & r, "A-" & s, j, t + 1)
    
53.     Next j
    
54.    
    
55. End Sub

复制代码