程序使用说明:
- A1开始m个单元格内写入各个待组合元素
- B1内写入需要提取的最大组合个数、范围[1-m]
- B2内写入任意字符作为组合元素间的分隔符(如为空则无分隔)
- B3内写入数字1时在D列输出m个元素的1-n的全部组合
B3留空时,仅输出Combin(m,n)即从m个元素中抽取n个的组合 - E列内容为提取组合中的元素个数n
递归组合结果在B4=1时按E列的个数n进行排序、留空时不排序
递归算法的顺序,其实是这样子的:
a → ab → abc;abd;abxx;abyyy
→ ac → acd;acxx;acyyy
→ ad → adxx;adyyy
→ axx → axxyyy
→ ayyy
b → bc → bcd;bcxx;bcyyy
→ bd → bdxx;bdyyy
→ bxx → bxxyyy
→ byyy
c → cd → cdxx;cdyyy
→ cxx → cxxyyy
→ cyyy
d → dxx → dxxyyy
→ dyyy
xx → xxyyy
yyy
然后,可以根据提取到元素个数来排序,就OK啦。
1.数组算法
Sub GetCombin_Arr() 'by kagawa 2014/11/28
Dim i&, j&, k&, l&, m&, n&, p&, w$, tms#
tms = Timer
m = [a1].End(4).Row: sj = [a1].Resize(m)
n = [b1]: If n > m Then n = m
w = [b2]: p = [b3]
[d1].CurrentRegion = ""
ReDim jg(2 ^ m - 1, 2)
For i = 1 To n - 1
For j = j To k
For l = jg(j, 2) + 1 To m
k = k + 1: jg(k, 1) = i: jg(k, 2) = l
If k > m Then jg(k, 0) = jg(j, 0) & w & sj(l, 1) Else jg(k, 0) = sj(l, 1)
Next
Next
Next
If p Then [d1].Resize(k + 1, 2) = jg
ReDim jg2(WorksheetFunction.Combin(m, n), 1): i = 0
For j = j To k
For l = jg(j, 2) + 1 To m
jg2(i, 0) = jg(j, 0) & w & sj(l, 1): jg2(i, 1) = n: i = i + 1
Next
Next
[d1].Offset(p * (k + 1)).Resize(i, 2) = jg2
[b5] = p * (k + 1) + UBound(jg2): [b6] = Format(Timer - tms, "0.000s")
End Sub
2.递归算法
Dim sj, jg(), k&, m&, n&, p&, w$
'定义公用变量、分别是:m个元素的数据sj数组、组合结果数组jg、记录序号k
'元素个数m、提取个数n、是否输出1-n的全部组合模式p、元素间分隔符号w
Sub GetCombin_dg() 'by kagawa 2014/11/28
Dim tms#
tms = Timer '代码运行起始时间tms
m = [a1].End(4).Row: sj = [a1].Resize(m) 'A列m个元素读入数组sj
n = [b1]: If n > m Then n = m '读取组合提取个数n
w = [b2] '读取元素间分隔符w
p = [b3] '是否需要输出1-n的全部组合: p=1时输出全部/p=0是仅输出n个元素的组合
[d1].CurrentRegion = "" '清空输出区域
ReDim jg(2 ^ m, 1) '定以存放组合结果的数组jg
k = 0: Call dgQZH("", 0, 0) '调用递归组合计算过程
[d1].Resize(k, 2) = jg: If p Then [d1].Resize(k, 2).Sort [e1], 1 '输出组合结果并排序
[b5] = k: [b6] = Format(Timer - tms, "0.000s") '代码运行耗时
End Sub
Sub dgQZH(r$, i&, t&) '递归组合过程代码
Dim j&
If p Or t = n Then jg(k, 0) = Mid(r, Len(w) + 1): jg(k, 1) = t: k = k + 1 '输出上一次拼接结果
If t = n Then Exit Sub '拼接组合到n个元素后就可以停止向下递归、退出。
For j = i + 1 To m '遍历本元素以后所有的元素
Call dgQZH(r & w & sj(j, 1), j, t + 1) '每次拼接一个元素、然后进入下一层递归组合计算
Next
End Sub