史上最酷的Excel VBA 组合算法 代码

aoe1981

香川群子 发表于 2013-9-24 10:25
我的代码是不可能有错误的。是你的要求有问题。

你的10个原始数据中0重复了3次……你想要得到什么样 ...

关于这个10取3的不重复排列数到底孰对孰错？备注：10个元素中3个相同的，其余7个元素与之不同，且彼此不同的情况。？？？

yjsemir

不明觉厉。。。。。。。。。。。。。。。

香川群子

aoe1981 发表于 2014-4-17 23:12
关于这个10取3的不重复排列数到底孰对孰错？备注：10个元素中3个相同的，其余7个元素与之不同，且彼此不同 ...

没有附件无法判断

香川群子

aoe1981 发表于 2014-4-17 23:12
关于这个10取3的不重复排列数到底孰对孰错？备注：10个元素中3个相同的，其余7个元素与之不同，且彼此不同 ...

完全不知道你说的是什么东西。

香川群子

aoe1981 发表于 2014-4-14 23:54
　　“但如果需要排除3个重复的0，则只有64个不重复组合结果，或者274个不重复排列结果。”——摘自55楼　 ...

10个数中3个相同，其余7个不同。
它们的排列组合排除重复结果以后的所有组合，是应该有 358个。你说的是对的。

aoe1981

香川群子 发表于 2014-4-18 13:59
10个数中3个相同，其余7个不同。
它们的排列组合排除重复结果以后的所有组合，是应该有 358个。你说的是 ...

哦，一般来说，逻辑推理想得的似乎没有实验罗列来的可靠……主要是从55楼看来，您的结果是代码罗列出来的……这下算是蹋实了……

exaction

厉害，好好研究一下

zhu918918

香川群子 发表于 2014-4-18 13:59
10个数中3个相同，其余7个不同。
它们的排列组合排除重复结果以后的所有组合，是应该有 358个。你说的是 ...

香川群子老师，有几个问题非常想请教您，首先是如何组合附件中的数据（ab2:ag35),每组6个。谢谢了！（希望运行尽量地快，我的电脑内存为512的）

香川群子

zhu918918 发表于 2014-5-22 00:38
香川群子老师，有几个问题非常想请教您，首先是如何组合附件中的数据（ab2:ag35),每组6个。谢谢了！（希望 ...

附件要求很简单，其实是典型的【香川多列组合】。

但是结果数比较多，附件例子中组合结果数=15*16*15*19*16*3=3,283,200 可以填满3列多。

香川群子

zhu918918 发表于 2014-5-22 00:38
香川群子老师，有几个问题非常想请教您，首先是如何组合附件中的数据（ab2:ag35),每组6个。谢谢了！（希望 ...

代码如附件。

附件为2003版，可自行转为2007版后使用。


请在AB列中输入原始数据的行序号，如果输入错误或留有空白间隔将影响原始数据读取。

1. Dim sj&(), jg&(), m&, n&, k&, cnt&, cnt2&
   
2. Sub MultiColumnCombin() 'by kagawa
   
3.    
   
4.     sj0 = [aa1].CurrentRegion.Offset(1, 1)
   
5.     '以AA1列中序号的行数决定原始数据区域大小。所以序号不能错！
   
6.    
   
7.     m = UBound(sj0) - 1: n = UBound(sj0, 2) - 1
   
8.     ReDim sj&(1 To m, 1 To n)
   
9.     For j = 1 To n
   
10.         k = 0
    
11.         For i = 1 To m
    
12.             If sj0(i, j) Then k = k + 1: sj(k, j) = sj0(i, j)
    
13.         Next
    
14.         If k > l Then l = k
    
15.     Next
    
16.     '以上把数据转为Long型数值 可以提高计算速度。
    
17.     m = l 'm更新为有效最大行数l 减少无效循环次数。
    
18. 
    
19.     cnt = [ai1]: ReDim jg&(cnt, 1 To n)
    
20.     '根据AI1中指定数值作为输出行数 如5万行，或100万行都可以。这样2003和2007都可以适用了。
    
21.     cnt2 = 1: [iv1].End(1).Offset(, 2) = cnt2
    
22.    
    
23.     k = 0: Call dgMN(1) '递归计算 并输出整数行的结果
    
24.     If k Then [iv1].End(1).Offset(1, 1).Resize(k, n) = jg '输出最后零数行的结果
    
25. End Sub
    
26. 
    
27. Sub dgMN(j&) '递归过程代码
    
28.     Dim i&, l&
    
29.     For i = 1 To m '循环本列
    
30.         If sj(i, j) = 0 Then Exit For '为空时退出
    
31.         jg(k, j) = sj(i, j) '填入组合数据
    
32.         If j = n Then '已经到最后一列(=n)时
    
33.             For l = 1 To n
    
34.                 If jg(k, l) Then Exit For Else jg(k, l) = jg(k - 1, l)
    
35.                 '循环检查如果本列为空则复制上一列数据 不为空则可退出
    
36.             Next
    
37.             k = k + 1
    
38.             If k = cnt Then '如果满足整数行则输出结果
    
39.                 k = 0: [iv1].End(1).Offset(1, 1).Resize(cnt, n) = jg
    
40.                 cnt2 = cnt2 + 1: [iv1].End(1).Offset(, 1 + n) = cnt2
    
41.             End If
    
42.         Else
    
43.             Call dgMN(j + 1) '递归到下一列
    
44.         End If
    
45.     Next
    
46. End Sub
    

复制代码

MultiColumnCombin.zip (13.25 KB, 下载次数: 154)

2014-5-22 09:22 上传

点击文件名下载附件