ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 3437|回复: 17

[原创] 【感恩节大礼:元素递增另类组合算法】之递归以及数组算法实现

[复制链接]

TA的精华主题

TA的得分主题

发表于 2014-11-28 11:18 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:递归
本帖最后由 香川群子 于 2014-11-28 13:23 编辑

从m个元素中提取n个元素的算法有很多种。

今天给大家介绍一种超级简单的思路,及其代码实现方法。

思路说明:
如有m=6个的元素组合: a,b,c,d,xx,yyy
希望提取n=3个的组合时:

第1步,提取1个元素,得到所有Combin(6,1)=6的组合:
a
b
c
d
xx
yyy
这样一共6个

第2步,上述6个各自添加1个后续元素,得到所有Combin(6,2)=6*5/2=15个的组合:
a → ab/ac/ad/axx/ayyy
b → bc/bd/bxx/byyy
c → cd/cxx/cyyy
d → dxx/dyyy
xx → xxyyy
这样一共是6个

接下来以此类推,就能得到从m个元素中任意抽取n个元素的全部各种组合了。

…………
此过程中,为了提取n个元素,需要依次提取:
全部1个元素的组合→ 全部2个元素的组合→ 全部3个元素的组合→……→ 全部n个元素的组合


呵呵,就是这么简单、就是这么任性!


具体请看附件! ZH2.zip (12.34 KB, 下载次数: 209)

评分

参与人数 3鲜花 +13 收起 理由
大力火手 + 8 感谢帮助
£Ulikeme + 2 值得肯定
张雄友 + 3 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-11-28 11:35 | 显示全部楼层
递归算法的代码实现:
  1. Dim sj, jg(), k&, m&, n&, p&, w$
  2. '定义公用变量、分别是:m个元素的数据sj数组、组合结果数组jg、记录序号k
  3. '元素个数m、提取个数n、是否输出1-n的全部组合模式p、元素间分隔符号w
  4. Sub GetCombin_dg() 'by kagawa 2014/11/28
  5.     Dim tms#
  6.     tms = Timer '代码运行起始时间tms
  7.     m = [a1].End(4).Row: sj = [a1].Resize(m) 'A列m个元素读入数组sj
  8.     n = [b1]: If n > m Then n = m '读取组合提取个数n
  9.     w = [b2] '读取元素间分隔符w
  10.     p = [b3]  '是否需要输出1-n的全部组合: p=1时输出全部/p=0是仅输出n个元素的组合
  11.     [d1].CurrentRegion = "" '清空输出区域
  12.    
  13.     ReDim jg(2 ^ m, 1) '定以存放组合结果的数组jg
  14.     k = 0: Call dgQZH("", 0, 0) '调用递归组合计算过程

  15.     [d1].Resize(k, 2) = jg: If p Then [d1].Resize(k, 2).Sort [e1], 1 '输出组合结果并排序
  16.     [b5] = k: [b6] = Format(Timer - tms, "0.000s") '代码运行耗时
  17. End Sub

  18. Sub dgQZH(r$, i&, t&) '递归组合过程代码
  19.     Dim j&
  20.     If p Or t = n Then jg(k, 0) = Mid(r, Len(w) + 1): jg(k, 1) = t: k = k + 1 '输出上一次拼接结果
  21.     If t = n Then Exit Sub '拼接组合到n个元素后就可以停止向下递归、退出。
  22.     For j = i + 1 To m '遍历本元素以后所有的元素
  23.         Call dgQZH(r & w & sj(j, 1), j, t + 1) '每次拼接一个元素、然后进入下一层递归组合计算
  24.     Next
  25. End Sub
复制代码

评分

参与人数 1鲜花 +2 收起 理由
£Ulikeme + 2 值得肯定

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-11-28 11:36 | 显示全部楼层
数组循环算法的代码实现:

解释略
  1. Sub GetCombin_Arr() 'by kagawa 2014/11/28
  2.     Dim i&, j&, k&, l&, m&, n&, p&, w$, tms#
  3.     tms = Timer
  4.    
  5.     m = [a1].End(4).Row: sj = [a1].Resize(m)
  6.     n = [b1]: If n > m Then n = m
  7.     w = [b2]: p = [b3]
  8.     [d1].CurrentRegion = ""
  9.    
  10.     ReDim jg(2 ^ m - 1, 2)
  11.     For i = 1 To n - 1
  12.         For j = j To k
  13.             For l = jg(j, 2) + 1 To m
  14.                 k = k + 1: jg(k, 1) = i: jg(k, 2) = l
  15.                 If k > m Then jg(k, 0) = jg(j, 0) & w & sj(l, 1) Else jg(k, 0) = sj(l, 1)
  16.             Next
  17.         Next
  18.     Next
  19.     If p Then [d1].Resize(k + 1, 2) = jg
  20.    
  21.     ReDim jg2(WorksheetFunction.Combin(m, n), 1): i = 0
  22.     For j = j To k
  23.         For l = jg(j, 2) + 1 To m
  24.             jg2(i, 0) = jg(j, 0) & w & sj(l, 1): jg2(i, 1) = n: i = i + 1
  25.         Next
  26.     Next
  27.     [d1].Offset(p * (k + 1)).Resize(i, 2) = jg2
  28.     [b5] = p * (k + 1) + UBound(jg2): [b6] = Format(Timer - tms, "0.000s")
  29. End Sub
复制代码

评分

参与人数 1鲜花 +2 收起 理由
£Ulikeme + 2 值得肯定

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-11-28 11:45 | 显示全部楼层
递归算法的顺序,其实是这样子的:

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鲜花 +2 收起 理由
£Ulikeme + 2 值得肯定

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-11-28 11:47 | 显示全部楼层
而数组循环算法中,已经安排了按字典顺序进行循环计算,所以输出结果不需要再经过排序。

评分

参与人数 1鲜花 +2 收起 理由
£Ulikeme + 2 值得肯定

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-11-28 13:24 | 显示全部楼层
程序使用说明:
1. A1开始m个单元格内写入各个待组合元素
2. B1内写入需要提取的最大组合个数、范围[1-m]
3. B2内写入任意字符作为组合元素间的分隔符(如为空则无分隔)
4. B3内写入数字1时在D列输出m个元素的1-n的全部组合
   B3留空时,仅输出Combin(m,n)即从m个元素中抽取n个的组合
5. E列内容为提取组合中的元素个数n
   递归组合结果在B4=1时按E列的个数n进行排序、留空时不排序

by Excel Home 香川群子 2014/11/28

评分

参与人数 1鲜花 +2 收起 理由
£Ulikeme + 2 值得肯定

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-11-28 13:28 | 显示全部楼层
裙子,
把你的相关帖子汇总起来,做个 排列/组合 工具库吧~

TA的精华主题

TA的得分主题

发表于 2014-11-28 18:02 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2014-11-28 22:34 | 显示全部楼层
都这么久了,你啥时候能学会用自文档化的方法来定义变量和写代码呢?

每次看你的程序太痛苦了,一堆jg、sj的,神一样的代码呀!

I 服了 you!

TA的精华主题

TA的得分主题

发表于 2014-11-29 14:24 | 显示全部楼层
liucqa 发表于 2014-11-28 22:34
都这么久了,你啥时候能学会用自文档化的方法来定义变量和写代码呢?

每次看你的程序太痛苦了,一堆jg、 ...

还没有细看完下面的资料,感觉自文档就是让代码本身像文档一样,具有好的阅读性:
http://www.cnblogs.com/anderslly ... cumenting-code.html
这是个专业的建议,这是个重视团队精神的建议!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-7-20 15:17 , Processed in 0.119470 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表