【关于多列组合问题】的求助 (香川多列组合)

中山郎

请教各位达人，我有两列数据A列分别是A，B，C一直到Z，B列是1,2,3一直到9，需要对他们进行组合，在C列自动填入9个A，9个B，9个C，一直到9个Z，D列循环填入9个1，9个2，9个3，一直到9个9。
当然这只是举例，实际数据很多，手机发帖，上不了附件，请各位不吝赐教。

香川群子女侠已经给出完美代码，在8楼。

liulang0808

主要是没有附件，看不太明白要怎么去实现，结果是怎样的

百度不到去谷歌

请搜索香川群子的排列组合

香川群子

这是典型的【香川多列组合】问题：

1. n列元素 (每1列行数可以不等)
2. 遍历每一列各取一个元素，然后组合。(得到n个元素的组合)
3. 组合总数=m1*m2*m3*……
    如果各列元素个数相等都是=m，则可简化计算结果=m^n

…………
楼主要求为26*9=234个不同的组合。

香川群子

就楼主要求来说，那么代码可以很直接，很简单：

1. Sub test()
   
2.     ReDim arr(1 To 26 * 9, 1 To 1)
   
3.     For i = 1 To 26
   
4.         For j = 1 To 9
   
5.             k = k + 1
   
6.             arr(k, 1) = Chr(i + 64) & j
   
7.         Next
   
8.     Next
   
9.     [a1].Resize(k) = arr
   
10. End Sub

复制代码

中山郎

谢谢裙子及各路大神。
裙子女侠的代码基本满足要求了，非常感谢！

中山郎

可能是我描述的不清楚，1楼描述中，只是示例，比较不贴切，现在上传真实情况的数据，就不是ABC123什么的，而是没有规律的数据，请裙子大侠帮帮忙哦。 组合.rar (10.08 KB, 下载次数: 63)

2014-7-23 10:11 上传

点击文件名下载附件

香川群子

中山郎 发表于 2014-7-23 10:13
可能是我描述的不清楚，1楼描述中，只是示例，比较不贴切，现在上传真实情况的数据，就不是ABC123什么的，而 ...

附件也只是2列……会有更多列么？
下面这个是通用的【香川多列组合】的递归算法代码：

1. Dim sj, jg(), m&, n&, k&
   
2. Sub MultiColumnCombin() 'by kagawa 香川多列组合
   
3.     Dim i&, j&, t&, tms#
   
4.     tms = Timer
   
5.    
   
6.     sj = [a1].CurrentRegion '以A1所在单元格区域为多列组合对象 数据读入数组sj
   
7.     m = UBound(sj): n = UBound(sj, 2) '获取最大行数m 和最大列数n
   
8.     k = 1 '组合总数k 初始值=1
   
9.     For j = 1 To n '遍历各列
   
10.         t = 0 '本列元素个数t 初始化
    
11.         For i = 1 To m '遍历本列各行
    
12.             If sj(i, j) <> "" Then t = t + 1
    
13.         Next
    
14.         k = k * t '计算组合总数
    
15.     Next
    
16.     ReDim jg(k, 1 To n) '根据计算组合总数定义结果数组jg
    
17.    
    
18.     k = 0: Call dgMN(1)  '调用递归计算过程 注意计数值k要初始化=0
    
19.    
    
20.     With [a1].Offset(, n + 2) '选择比原始数据隔开2列的单元格作为输出结果的起始位置
    
21.         .CurrentRegion = "" '清空输出区域
    
22.         .Resize(k, n) = jg '输出结果
    
23.     End With
    
24.    
    
25.     MsgBox Format(Timer - tms, "0.000s ") & k '耗时以及组合结果总数k
    
26. End Sub
    
27. 
    
28. Sub dgMN(j&) '递归计算过程 (参数j为递归进入的列位置)
    
29.     Dim i&, j1&, t
    
30.     For i = 1 To m '遍历各行
    
31.         t = sj(i, j) '读取该行该列位置的内容
    
32.         If t = "" Then
    
33.             Exit For '如果该位置为空白单元格即可提前退出。（如需强行计算则注销本句）
    
34.         Else
    
35.             jg(k, j) = t '在结果数组jg中对应列位置记录本次递归计算得到的组合结果
    
36.             If j = n Then '如果已到最后一列n列 则可确定本次组合结果
    
37.                 For j1 = 1 To n '把当前组合结果传递到下一组合
    
38.                     If jg(k, j1) <> "" Then Exit For Else jg(k, j1) = jg(k - 1, j1)
    
39.                 Next
    
40.                 k = k + 1 '结果数组jg的计数k序号参数+1 更新记录位置进入下一行。
    
41.             Else
    
42.                 Call dgMN(j + 1) '如果还没到最后1列n列 则继续递归进入到下一列。
    
43.             End If
    
44.         End If
    
45.     Next
    
46. End Sub
    

复制代码

中山郎

香川群子 发表于 2014-7-23 11:13
附件也只是2列……会有更多列么？

只有两列，没有更多列

香川群子

中山郎 发表于 2014-7-23 11:15
只有两列，没有更多列

更多列也没关系……代码已经在8楼贴出了。