香川组合的递归代码

香川群子

有m行n列数据，要求各列中任意抽取一个元素，共n个元素重新组合，求列出所有组合结果。


举例：
A 1 甲
B 2 乙
C 3 丙

得到结果：
A;1;甲
A;1;乙
A;1;丙
A;2;甲
A;2;乙
A;2;丙
A;3;甲
A;3;乙
A;3;丙
B;1;甲
B;1;乙
B;1;丙
B;2;甲
B;2;乙
B;2;丙
B;3;甲
B;3;乙
B;3;丙
C;1;甲
C;1;乙
C;1;丙
C;2;甲
C;2;乙
C;2;丙
C;3;甲
C;3;乙
C;3;丙

香川群子

结果组合实际上有个特点，第k列的元素永远只在第k列中出现。

因此，实际上组合总数=m^n
即，每列元素都是m个中任取一个元素 = m 种变化，
而每增加1列，就多一次乘法。2列就是 m^2 ，3列就是 m^3 ……，


我以前用数组循环代码实现，但代码比较复杂。（当列数不定时，循环次数也不同）

但是，用递归方法写出的代码，却很简单：

1. Public sj, jg(), m, n, r
   
2. Sub 香川组合递归()
   
3.     sj = ActiveCell.CurrentRegion: m = UBound(sj): n = UBound(sj, 2): Amn = m ^ n
   
4.     If Amn > 65536 Then Exit Sub Else ReDim jg(Amn, 0): r = 0
   
5.     Call mndg("", 0, 0)
   
6.     ActiveCell.CurrentRegion.Cells(1).offset(m + 3, n).Resize(r) = jg
   
7. End Sub
   
8. Sub mndg(s$, i, t%)
   
9.     If t = n Then
   
10.         p = Split(s, ";")
    
11.         For j = 1 To n
    
12.             jg(r, 0) = jg(r, 0) & ";" & sj(p(j), j)
    
13.         Next
    
14.         jg(r, 0) = Mid(jg(r, 0), 2): r = r + 1: Exit Sub
    
15.     End If
    
16.     For j = i + 1 To m
    
17.         Call mndg(s & ";" & j, 0, t + 1)
    
18.     Next j
    
19. End Sub

复制代码

Pferdcheng

完全看不懂，但来学习下

maditate

香穿裙子又有新作品了。

liucqa

支持一下            

guojianlin1985

但是数据量大的时候递归会很慢的。

列数不确定应该也不影响循环吧。

香川群子

如果考虑到，原始数据区域中可能包含空白单元格，要剔除，则代码修改如下：
另外，各个组合的所有各列元素的结果也直接输出了。

1. Public sj, jg(), m, n, r
   
2. Sub 香川组合递归()
   
3.     sj = ActiveCell.CurrentRegion: m = UBound(sj): n = UBound(sj, 2): Amn = m ^ n
   
4.     If Amn > 65536 Then Exit Sub Else ReDim jg(Amn, 1 To n + 1): r = 0
   
5.     Call mndg("", 0, 0)
   
6.     ActiveCell.CurrentRegion.Cells(1).offset(m + 3).Resize(r, n + 1) = jg
   
7. End Sub
   
8. Sub mndg(s$, i, t%)
   
9.     If t = n Then
   
10.         p = Split(s, ";")
    
11.         For j = 1 To n
    
12.             jg(r, j) = sj(p(j), j)
    
13.             jg(r, n + 1) = jg(r, n + 1) & ";" & sj(p(j), j)
    
14.         Next
    
15.         jg(r, n + 1) = Mid(jg(r, n + 1), 2): r = r + 1: Exit Sub
    
16.     End If
    
17.     For j = i + 1 To m
    
18.         If sj(j, t + 1) <> "" Then Call mndg(s & ";" & j, 0, t + 1)
    
19.     Next j
    
20. End Sub

复制代码

yiyiyicz

留个记号，学习

香川群子

顺便公开一下，标准组合、标准排列的递归代码：

1. Sub 香川组合递归()
   
2.     sj = [a1].CurrentRegion: m = UBound(sj): n = UBound(sj, 2): Amn = m ^ n
   
3.     If Amn > 65536 Then Exit Sub Else ReDim jg(Amn, n): r = 0
   
4.     Call mndg("", 0, 0)
   
5.     [a1].offset(, n + 3).CurrentRegion = "": [a1].offset(, n + 1) = Amn: [a1].offset(, n + 3).Resize(Amn, n + 1) = jg
   
6. End Sub
   
7. Sub mndg(s$, i, t%)
   
8.     If t = n Then
   
9.         p = Split(s, ";")
   
10.         For j = 1 To n
    
11.             jg(r, j) = sj(p(j), j)
    
12.             jg(r, 0) = jg(r, 0) & ";" & sj(p(j), j)
    
13.         Next
    
14.         jg(r, 0) = Mid(jg(r, 0), 2): r = r + 1: Exit Sub
    
15.     End If
    
16.     For j = i + 1 To m
    
17.         If sj(j, t + 1) <> "" Then Call mndg(s & ";" & j, 0, t + 1)
    
18.     Next j
    
19. End Sub
    
20. Sub 排列递归()
    
21.     m = [a1].End(4).Row: sj = [a1].Resize(m): n = [b1]
    
22.     AP = WorksheetFunction.Permut(m, n): ReDim jg(AP, n): r = 0
    
23.     Call pldg("", 0)
    
24.     [b3] = AP: [d1].CurrentRegion: [d1].Resize(AP, n + 1) = jg
    
25. End Sub
    
26. Sub pldg(s$, t%)
    
27.     If t = n Then
    
28.         p = Split(s, ";")
    
29.         For j = 1 To n
    
30.             jg(r, j) = sj(p(j), 1)
    
31.             jg(r, 0) = jg(r, 0) & ";" & sj(p(j), 1)
    
32.         Next
    
33.         jg(r, 0) = Mid(jg(r, 0), 2): r = r + 1: Exit Sub
    
34.     End If
    
35.     For j = 1 To m
    
36.         If InStr(s & ";", ";" & j & ";") = 0 Then Call pldg(s & ";" & j, t + 1)
    
37.     Next j
    
38. End Sub
    
39. Sub 组合递归()
    
40.     m = [a1].End(4).Row: sj = [a1].Resize(m): n = [b1]
    
41.     AC = WorksheetFunction.Combin(m, n): ReDim jg(AC, n): r = 0
    
42.     Call zhdg("", 0, 0)
    
43.     [b3] = AC: [d1].CurrentRegion = "": [d1].Resize(AC, n + 1) = jg
    
44. End Sub
    
45. Sub zhdg(s$, i, t%)
    
46.     If t = n Then
    
47.         p = Split(s, ";")
    
48.         For j = 1 To n
    
49.             jg(r, j) = sj(p(j), 1)
    
50.             jg(r, 0) = jg(r, 0) & ";" & sj(p(j), 1)
    
51.         Next
    
52.         jg(r, 0) = Mid(jg(r, 0), 2): r = r + 1: Exit Sub
    
53.     End If
    
54.     For j = i + 1 To m
    
55.         Call zhdg(s & ";" & j, j, t + 1)
    
56.     Next j
    
57. End Sub

复制代码

AVEL

递归一直都学不会。。 群子老师怎么学的？介绍经验。。