ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 12903|回复: 32

[分享] VBA菜鸟福音--通用M选N组合工具,随取随用,不懂算法你也可以玩组合了!

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2014-3-28 16:22 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖已被收录到知识树中,索引项:其他结构和算法
本帖最后由 百度不到去谷歌 于 2014-3-28 16:27 编辑

不懂算法,你也可以玩M选N组合,你只需要M组合工具
模块插入到你的工程中,就可方便的调用组合方法了
前段时间遇到几个组合问题,当然首先是百度一下,各位前辈高人算法都很厉害,可是众菜鸟们怕是难以理解
不能理解又要用到,怎么办呢,我综合看了几种算法,灰袍法师的算法比较简单,容易理解,便于包装,于是我以
灰袍法师算法为蓝本,对原算法进行了参数化处理,传入参数也做了处理,可直接传进一维数组,以及range区域,
原版只处理数值,这里可处理数值或者字符串,总共打包了3个公共方法详解如下,

'###########M组合工具#算法:灰袍法师--整理:百度不到去谷歌################################

'#功    能:对M个元素选N组合,输出数组,或工作表区域,接口简单,使用方便,可不懂算法直接调用
'#CombinToArr(ArrRng, N%)--按行输出到全局数组ResultArr(),受内存限制
'#CombinToRngByRow(ArrRng, N%, target As Range)    --按行依次输出到工作表,受行列数限制
'#CombinToRngByColumn(ArrRng, N%, target As Range) --按第1关键字分列输出到工作表,受行列限制
'#参    数:ArrRng----一维数组,或者rng区域,split得到的数组可直接传入
                       N----选取个数;
                       target----输出区域左上角单元格
'######################################################################################

有需要的同学可以参考原灰袍法师的帖子 猛击这里http://club.excelhome.net/thread-643613-1-1.html
另外香川群子的组合算法速度很快,不过我理解不深,改造起来比较难,有兴趣可以猛击这里http://club.excelhome.net/thread-643613-1-1.html
VBA - 通用组合工具.rar (43.65 KB, 下载次数: 779)
QQ截图20140328162000.jpg QQ截图20140328161917.jpg

评分

3

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-3-28 20:41 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2014-4-1 11:38 | 显示全部楼层
我的组合算法帖子链接是这个:
http://club.excelhome.net/thread-1033055-1-1.html

最酷、最快的代码过程写成通用函数是:

从arr数组的m个元素中提取n个的全部组合,并返回n列的数组结果。
  1. Function CombinDoArr(arr, m&, n&)
  2.     Dim i&, j&, k&, l&, s$, t&
  3.     k = Application.Combin(m, n)
  4.     ReDim brr(1 To k, 1 To n)
  5.    
  6.     ReDim a&(1 To n)
  7.     For j = 1 To n - 1
  8.         a(j) = j
  9.     Next
  10.    
  11.     i = n - 1: k = 0 ': j = n
  12.     Do
  13.         For i = i + 1 To m
  14.             a(j) = i
  15.             k = k + 1
  16.             For l = 1 To n
  17.                 brr(k, l) = arr(a(l), 1)
  18.             Next
  19.         Next
  20.         
  21.         For j = j - 1 To 1 Step -1
  22.             i = a(j) + 1: a(j) = i
  23.             If i = m - n + j Then
  24.                 k = k + 1
  25.                 For l = 1 To n
  26.                     brr(k, l) = arr(a(l), 1)
  27.                 Next
  28.             Else
  29.                 j = j + 1
  30.                 Do Until j = n
  31.                     i = i + 1: a(j) = i: j = j + 1
  32.                 Loop
  33.                 If i = m Then Exit Do Else Exit For
  34.             End If
  35.         Next
  36.     Loop Until j = 0
  37.     CombinDoArr = brr '组合结果数组brr 返回给该函数名
  38. End Function
复制代码
下面是运用实例
  1. Sub CombinTest() 'by kagawa
  2.     Dim arr, brr, m&, n&
  3.     m = [a1].End(4).Row '获取A列元素最大行m (含A1单元格)
  4.     arr = [a1].Resize(m)   'A列数据读入数组arr
  5.     n = [b1]  '获取组合提取数n

  6.     brr = CombinDoArr(arr, m, n) '调用组合函数直接得到结果数组brr

  7.     [d1].CurrentRegion = "" '清空输出数据区域
  8.     [d1].Resize(UBound(brr), n) = brr '输出到工作表
  9. End Sub
复制代码
我的组合算法目前速度最快,
主要是因为:
1. 每一步都能生成一个组合,没有多余动作(代码冗余过程最少)。
2. 代码过程中最大限度地利用变量传递,提高了速度效率。
   i = a(j) + 1: a(j) = i
    以及这样的处理
                j = j + 1
                Do Until j = n
                    i = i + 1: a(j) = i: j = j + 1
                Loop

3. 提取最后一个组合n位置时,直接使用内部For循环,大大减少了外部Do循环的空转。
      For i = i + 1 To m
            a(j) = i
            k = k + 1
            For l = 1 To n
                brr(k, l) = arr(a(l), 1)
            Next
        Next

4. 在 i = m - n + j 状态时也直接提取组合结果,省去了多余动作
        If i = m - n + j Then
                k = k + 1
                For l = 1 To n
                    brr(k, l) = arr(a(l), 1)
                Next
            Else

呵呵。

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-4-1 11:45 | 显示全部楼层
刚才的代码上个附件。

…………
如果是需要把组合结果合并,则应该改写成直接使用Mid函数拼接,而不是写入数组后在&连起来。

…………
总之,以我的组合算法为核心,根据实际需求改写才能发挥最大的效率。

Combin_Kagawa.zip

8.54 KB, 下载次数: 412

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-4-1 14:39 | 显示全部楼层
香川群子 发表于 2014-4-1 11:45
刚才的代码上个附件。

…………

知道你是最快的代码 只是没理解透彻所以不好打包 感谢你写了这个算法的通用过程  
万分希望你的精妙算法 都能写成通用过程 这样便于大家在不需要深入理解的情况下
也能方便使用 毕竟研究算法的人凤毛菱角 使用确实有大量的需求

TA的精华主题

TA的得分主题

发表于 2014-4-1 18:37 | 显示全部楼层
百度不到去谷歌 发表于 2014-4-1 14:41
知道你是最快的代码 只是没理解透彻所以不好打包 感谢你写了这个算法的通用过程  
万分希望你的精妙算法 ...

那你接下来就花时间慢慢研究我上面的代码。

整理个学习笔记出来。


实在不懂再来问我。

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-4-1 19:09 | 显示全部楼层
香川群子 发表于 2014-4-1 18:37
那你接下来就花时间慢慢研究我上面的代码。

整理个学习笔记出来。

我的目的不是追求最好的算法和最快的速度 是遇到问题能解决 如果有工具能用 我是不会研究算法的
除非实在找不到工具 出发点不太一样

TA的精华主题

TA的得分主题

发表于 2014-4-2 09:46 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
不錯,想穿裙子老師善於深入思考,值得學習

TA的精华主题

TA的得分主题

发表于 2014-4-2 10:06 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2014-4-24 11:15 | 显示全部楼层
谢谢分享,做个记号,有用的时候学习一下
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 03:03 , Processed in 0.061107 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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