中秋小礼物 香川多列不重复组合 【彩民福音】

香川群子

彩民最喜欢组合什么的了，但自己又不会搞……呵呵。

附件功能为：
A列区域内多列写入待组合的数字，然后每个列中只取一个数进行组合。
要求生成的组合内数字不重复，并排序。

1. Dim sj, jl(), jg&(), dic, m&, n&, k&
   
2. Sub kagawa() '香川多列不重复组合
   
3.     tms = Timer
   
4.    
   
5.     sj = [a1].CurrentRegion '数据读入数组sj
   
6.     ReDim jl(1 To WorksheetFunction.Max(sj)) '找到最大值并定义记录组内不重复的数组jl
   
7.    
   
8.     m = UBound(sj): n = UBound(sj, 2) '读取行数m、列数n
   
9.     ReDim jg&(m ^ n, n - 1) '定义输出组合结果的数组jg
   
10.         
    
11.     Set dic = CreateObject("Scripting.Dictionary") '设置去重复用字典dic
    
12.    
    
13.     k = 0: Call dgMN(1) '调用递归
    
14.     MsgBox Format(Timer - tms, "0.000s ") & k '运行耗时及组合结果数k
    
15.    
    
16.     With [a1].Offset(, n + 2)
    
17.         .CurrentRegion = "" '清空
    
18.         .Resize(k, n) = jg  '输出
    
19.         .Resize(, n).EntireColumn.AutoFit  '列幅调整
    
20.         For j = n To 1 Step -1
    
21.             .Resize(k, n).Sort .Offset(, j - 1), 1 '排序
    
22.         Next
    
23.     End With
    
24.    
    
25. End Sub
    
26. 
    
27. Sub dgMN(j&)
    
28.     Dim i&, k2&, l&, r$, s, t&
    
29.     For i = 1 To m '遍历各行
    
30.         t = sj(i, j): If t = 0 Then Exit For '本列无数据时退出
    
31.         
    
32.         If jl(t) = "" Then '组内记录不重复时继续
    
33.             jl(t) = t '记录这一组中该值t已被占用
    
34.             If j = n Then '递归到最后一列时
    
35.                 r = WorksheetFunction.Trim(Join(jl)) '从记录中提取该组 从小到大不重复的组合结果r
    
36.                 If Not dic.Exists(r) Then '字典检查不重复时
    
37.                     dic(r) = "" '加入字典
    
38.                     
    
39.                     s = Split(r) '拆分该组合结果r
    
40.                     For l = 0 To n - 1
    
41.                         jg(k, l) = s(l) '输出该组合到结果数组jg
    
42.                     Next
    
43.                     k = k + 1    '结果记录序号k+1
    
44.                 End If
    
45.             Else
    
46.                 Call dgMN(j + 1) '还不到最后一列时 继续递归进入下一列
    
47.             End If
    
48.             jl(t) = "" '记录中释放该值
    
49.         End If
    
50.     Next
    
51. End Sub
    

复制代码

香川多列组合递归+字典去重复.rar (12.69 KB, 下载次数: 903)

2014-9-8 12:16 上传

点击文件名下载附件

天地有雪

感谢香川老师分享！

zhouzhongchi

谢谢！代码有注释方便理解消化，递归太难懂了。

ak47ok

香川老师偏心，彩民的就不是用来获利的、股民的就是用来获利的……
每次回帖、谢谢！辛苦了。

张雄友

anyway ，强大。做个通用性强一些的，比如能忽略空值，跨列输出等等。

香川群子

张雄友 发表于 2014-9-7 17:33
anyway ，强大。做个通用性强一些的，比如能忽略空值，跨列输出等等。

忽略空值很容易做到，但跨列输出是什么意思呢?

张雄友

香川群子 发表于 2014-9-8 12:19
忽略空值很容易做到，但跨列输出是什么意思呢?

节假日还能关注，谢谢！附件说明了。彩不彩民不知道，但在实际工作中有举足轻重的用途。

百度不到去谷歌

女侠 你这样 只会让彩民越陷越深啊。。。虽然你确实一片好心

香川群子

百度不到去谷歌 发表于 2014-9-9 23:29
女侠 你这样 只会让彩民越陷越深啊。。。虽然你确实一片好心

呵呵，彩民是可怜的人……

的风格123123

下载学习中...谢谢分享