【高级通用】元素分组排列组合 的递归算法代码

香川群子

m个元素进行分组，分组个数可任意指定为1-m组，而每一分组的个数可以不同……

这样就可以得到各种复杂的分组方案，且可以涵盖所有Combin(m,n)组合、或Permut(m,n)排列。

例如： ABCDE进行2、2、1组间不排列分组时，可以得到以下8种分组组合。
AB|CD|E
AB|CE|D
AC|BD|E
AC|BE|D
AD|BC|E
AD|BE|C
AE|BC|D
AE|BD|C

而如果 ABCDE进行2、2、1组间排列分组时，可以得到30种分组组合。
AB|CD|E
AB|CE|D
AB|DE|C
AC|BD|E
AC|BE|D
AC|DE|B
AD|BC|E
AD|BE|C
AD|CE|B
AE|BC|D
AE|BD|C
AE|CD|B
BC|AD|E
BC|AE|D
BC|DE|A
BD|AC|E
BD|AE|C
BD|CE|A
BE|AC|D
BE|AD|C
BE|CD|A
CD|AB|E
CD|AE|B
CD|BE|A
CE|AB|D
CE|AD|B
CE|BD|A
DE|AB|C
DE|AC|B
DE|BC|A

香川群子

如果需要得到=Combin(m,n)组合，则只要这样设置：
①把m个元素分为两组。
②设置第2组的分组位置为=n+1位置、且值=1 即可。

分组计算后输出的结果为：
左边Combin(m,n)分组结果，右边为Combin(m,m-n)分组结果。（不过输出顺序相反）

注意Combin(m,m)和Combin(m,0)等价。

如果需要得到=Permut(m,n)组合，则只要这样设置：
①把m个元素分为两组。
②设置第1 到 n+1位置的值=1 即可。

注意Permut(m,m)和Permut(m,m-1)等价。

香川群子

代码：

1. Dim sj, sj2, jg2$(), k&, l&, m&, n&, n2&, w1$, w2$, cnt&
   
2. Sub MultiCombinPermut() 'by kagawa
   
3.     Dim cc, i&, m1, s$, t, tms#
   
4.     'Combin(5,0-5)=10000;01000;00100;00010;00001;10000
   
5.     'Permut(5,0-5)=10000;11000;11100;11110;11111;11111
   
6.    
   
7.     m = [a3].End(4).Row - 3
   
8.     w1 = [a2]: w2 = [b2]: n2 = Len(w2) + 1
   
9.     [c:d] = "": sj = [a4].Resize(m, 3)
   
10.    
    
11.     n = 1: cc = 1: t = 1
    
12.     Cells(4, 3).Activate
    
13.     For i = 2 To m
    
14.         If sj(i, 2) Then
    
15.             If sj(i, 2) = t Then
    
16.                 m1 = m - n + 1: n = i - n
    
17.             Else
    
18.                 s = s & vbCr & "Combin(1,1)=1"
    
19.                 ActiveCell = "Combin(1,1)=1"
    
20.                 ActiveCell.Offset(1).Activate
    
21.                 m1 = m - n: n = i - n - 1: t = sj(i, 2)
    
22.             End If
    
23.             k = WorksheetFunction.Combin(m1, n): cc = TM2(cc, k) '此处调用长数位乘法自定义函数
    
24.             s = s & vbCr & "Combin(" & m1 & "," & n & ")=" & k
    
25.             ActiveCell = "Combin(" & m1 & "," & n & ")=" & k
    
26.             n = i
    
27.             Cells(i + 3, 3).Activate
    
28.         End If
    
29.     Next
    
30.     s = s & vbCr & "Combin(" & m - n + 1 & "," & i - n & ")=1"
    
31.     ActiveCell = "Combin(" & m - n + 1 & "," & i - n & ")=1"
    
32.     [c3] = "k=" & cc: MsgBox "k=" & Format(cc, "#,##0") & s
    
33.    
    
34.     l = Val(InputBox("Output Count Lines:", "l=", IIf(cc > Rows.Count, Rows.Count, cc)))
    
35.     If l = 0 Then Exit Sub
    
36.    
    
37.     tms = Timer: [c2] = "Output: " & l: ReDim jg2$(l, 0)
    
38.     ReDim sj2(1 To m) As Boolean
    
39.    
    
40.     k = 0: cnt = 0: Call dgZH4("", 0, 1)
    
41.     [d1].Resize(k) = jg2
    
42.     [c1:d1].EntireColumn.AutoFit
    
43.     MsgBox Format(Timer - tms, "0.000s ") & k & "/" & cnt
    
44. End Sub
    
45. Sub dgZH4(s$, i&, t&)
    
46.     Dim ii&, j&, s2$, t2&
    
47.     If k = l Then Exit Sub
    
48.     cnt = cnt + 1
    
49.     For j = i + 1 To m
    
50.         If Not sj2(j) Then
    
51.             If t < n Then
    
52.                 sj2(j) = True
    
53.                 If sj(t + 1, 2) = "" Then
    
54.                     If sj(t, 2) Then sj(sj(t, 2) + 1, 3) = j - 1
    
55.                     Call dgZH4(s & w2 & sj(j, 1), j, t + 1)
    
56.                 Else
    
57.                     Call dgZH4(s & w2 & sj(j, 1) & w1, Val(sj(sj(t + 1, 2), 3)), t + 1)
    
58.                 End If
    
59.                 sj2(j) = False
    
60.             Else
    
61.                 For ii = sj(sj(t, 2), 3) + 1 To m
    
62.                     If Not sj2(ii) Then s2 = s2 & w2 & sj(ii, 1): t2 = t2 + 1
    
63.                 Next
    
64.                 If t + t2 = m + 1 Then
    
65.                     If w1 = "" Then '增加当组间符设置为空时，不输出最后一组。
    
66.                         jg2(k, 0) = Mid(s, n2)
    
67.                     Else
    
68.                         jg2(k, 0) = Replace(Mid(s & s2, n2), w1 & w2, w1)
    
69.                     End If
    
70.                     k = k + 1
    
71.                 End If
    
72.                 Exit Sub
    
73.             End If
    
74.         End If
    
75.     Next
    
76. End Sub
    

复制代码

香川群子

另需要能计算长数位整数乘法的自定义函数代码，否则当组合结果总数很大时无法计算了：

自定义函数代码如下：

1. Function TM2(ByVal Na, ByVal Nb)
   
2.     Dim i&, j&, la&, lb&
   
3.     If Na = 0 Or Nb = 0 Then TM2 = "0": Exit Function
   
4.     If Len(Na) < Len(Nb) Then TM2 = TM2(Nb, Na): Exit Function
   
5.     If Len(Nb) < 12 Then l = 26 - Len(Nb) Else l = 12
   
6.      
   
7.     la = (Len(Na) - 1) \ l
   
8.     ReDim a(la)
   
9.     For i = 1 To la
   
10.         a(i - 1) = CDec(Mid(Na, Len(Na) - l * i + 1, l))
    
11.     Next
    
12.     a(la) = CDec(Mid(Na, 1, Len(Na) - l * la))
    
13.    
    
14.     lb = (Len(Nb) - 1) \ l
    
15.     ReDim b(lb)
    
16.     For i = 1 To lb
    
17.         b(i - 1) = CDec(Mid(Nb, Len(Nb) - l * i + 1, l))
    
18.     Next
    
19.     b(lb) = CDec(Mid(Nb, 1, Len(Nb) - l * lb))
    
20.    
    
21.    
    
22.     ReDim c(la + lb)
    
23.     For i = 0 To la
    
24.         For j = 0 To lb
    
25.             c(la - i + lb - j) = c(la - i + lb - j) + a(i) * b(j)
    
26.         Next
    
27.     Next
    
28.    
    
29.     For i = la + lb To 1 Step -1
    
30.         If Len(c(i)) > l Then
    
31.             If i = 1 Then
    
32.                 c(0) = c(0) + Left(c(i), Len(c(i)) - l)
    
33.                 If Len(c(0)) > l Then c(0) = Left(c(0), Len(c(0)) - l) & Right(c(0), l)
    
34.             Else
    
35.                 c(i - 1) = Format(c(i - 1) + Left(c(i), Len(c(i)) - l), String(l, "0"))
    
36.             End If
    
37.             c(i) = Right(c(i), l)
    
38.         ElseIf Len(c(i)) < l Then
    
39.             c(i) = Format(c(i), String(l, "0"))
    
40.         End If
    
41.     Next
    
42.     TM2 = Join(c, "")
    
43. End Function
    

复制代码

aoe1981

从您给出的这两组例子来看，和我的方法算出的各组组合总数：8，各组排列总数：30，是一致的！
我发现了一条计算此类结果数的公式，但是在用代码实现公式中的思路的过程中，看来不尽完善……
我的公式是什么样，在做好准备后，我会在我的帖子中一并介绍的，我会详细说说我的代码的思路的，供大家诊断……

aoe1981

比如：分组为3组，各组为3、4、5人，总人数为12人的组合总数是：3080种，至于排列数，从公式角度出发，这个容易多了，但对于代码的罗列，我涉猎不多，连普通排列结果的罗列，也只停留在普通循环、排除的水平上……呵呵

再比如：分组为4组，各组为1、2、3、4人，总人数为10人的组合总数是：120种
凡此种种……

香川群子

最大的特点是：

后面分组和前面分组之间，是排列还是组合的关系，这个可以任意设定。

方法是：
① 如果设置分组参数值=上一分组参数值，则进行排列运算。
   即，该小组的组合包含所有剩余元素数的组合 → 所有剩余元素都参与运算

② 如果设置分组参数值=上一分组参数值+1，则进行组合运算。
  即，仅包含比上一组起始位置值更大位置值的组合。
  举例，上一组首位是第3个位置，则本组开始的组合都是从第4个位置开始，不再包含第1和第2位置。

…………
这个使得我的代码可以计算更加复杂、更加自由的组合。

wcymiss

“例如：ABCDE进行2、2、1组间不排列分组时，可以得到以下8种分组组合。”

BC|DE|A

这种没有吗？A、B不能被单独分组？

香川群子

wcymiss 发表于 2014-11-11 12:21
“例如：ABCDE进行2、2、1组间不排列分组时，可以得到以下8种分组组合。”

BC|DE|A

呵呵，你没有仔细看帖，没有看懂我的说明。

ABCDE进行2、2、1组间不排列分组时，可以得到以下8种分组组合。
此时，不包含BC|DE|A分组，因为是按顺序分组的。A必须排第1个。


而如果 ABCDE进行2、2、1组间排列分组时，就可以得到30种分组组合。
你提到的BC|DE|A分组，在第15个位置出现。

以上例子，都在1楼列出了。

mmwwdd

好贴，香川群子都是经典贴