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

百度不到去谷歌 · 发表于 2014-3-28 16:22

本帖最后由百度不到去谷歌于 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, 下载次数: 785)

李大明 · 发表于 2014-3-28 20:41

非常不错，谢谢分享

香川群子 · 发表于 2014-4-1 11:38

我的组合算法帖子链接是这个：
http://club.excelhome.net/thread-1033055-1-1.html

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

从arr数组的m个元素中提取n个的全部组合，并返回n列的数组结果。

Function CombinDoArr(arr, m&, n&)
Dim i&, j&, k&, l&, s$, t&
k = Application.Combin(m, n)
ReDim brr(1 To k, 1 To n)
ReDim a&(1 To n)
For j = 1 To n - 1
a(j) = j
Next
i = n - 1: k = 0 ': j = n
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
For j = j - 1 To 1 Step -1
i = a(j) + 1: a(j) = i
If i = m - n + j Then
k = k + 1
For l = 1 To n
brr(k, l) = arr(a(l), 1)
Next
Else
j = j + 1
Do Until j = n
i = i + 1: a(j) = i: j = j + 1
Loop
If i = m Then Exit Do Else Exit For
End If
Next
Loop Until j = 0
CombinDoArr = brr '组合结果数组brr 返回给该函数名
End Function

复制代码

下面是运用实例

Sub CombinTest() 'by kagawa
Dim arr, brr, m&, n&
m = [a1].End(4).Row '获取A列元素最大行m (含A1单元格)
arr = [a1].Resize(m) 'A列数据读入数组arr
n = [b1] '获取组合提取数n
brr = CombinDoArr(arr, m, n) '调用组合函数直接得到结果数组brr
[d1].CurrentRegion = "" '清空输出数据区域
[d1].Resize(UBound(brr), n) = brr '输出到工作表
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

呵呵。

香川群子 · 发表于 2014-4-1 11:45

刚才的代码上个附件。

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

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

百度不到去谷歌 · 发表于 2014-4-1 14:39

香川群子发表于 2014-4-1 11:45
刚才的代码上个附件。

…………

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

香川群子 · 发表于 2014-4-1 18:37

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

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

整理个学习笔记出来。

实在不懂再来问我。

百度不到去谷歌 · 发表于 2014-4-1 19:09

香川群子发表于 2014-4-1 18:37
那你接下来就花时间慢慢研究我上面的代码。

整理个学习笔记出来。

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

592rmb · 发表于 2014-4-2 09:46

不錯，想穿裙子老師善於深入思考，值得學習

wenwen000424 · 发表于 2014-4-2 10:06

作个记号,以便学习.

hozhang · 发表于 2014-4-24 11:15

谢谢分享，做个记号，有用的时候学习一下

		自动登录	找回密码
密码			免费注册

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

评分

评分

评分