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

中山郎

香川群子 发表于 2014-7-23 11:36
更多列也没关系……代码已经在8楼贴出了。

想穿裙子女侠太给力了，完美，完美，谢谢，谢谢！

香川群子

楼主请把标题改一下：

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

张雄友

香川群子 发表于 2014-7-23 11:13
附件也只是2列……会有更多列么？
下面这个是通用的【香川多列组合】的递归算法代码：

结果怎么不是合并起来的？

中山郎

张雄友 发表于 2014-7-23 18:39
结果怎么不是合并起来的？

根据我的请求做的

香川群子

中山郎 发表于 2014-7-24 13:07
根据我的请求做的

稍稍修改一下，把各列元素合并组合为一个字符串然后输出的代码：

需要输入分隔符。(可以默认留空，或直接在代码中固化设置好。)

1. 
   
2. Dim sj, jg(), m&, n&, k&, w$  '公共变量中增加了一个分隔符w$变量
   
3. Sub MultiColumnCombin() 'by kagawa
   
4.     Dim i&, j&, tms#
   
5.    
   
6.     'l = MsgBox("Yes to output Multi-Columns, No to only One Column", vbYesNo)
   
7.     'If l = vbNo Then w = InputBox("Please input insert-word", "One Column Only")
   
8.     l = MsgBox("是 = 多列输出,  否 = 单列合并输出", vbYesNo)
   
9.     If l = vbNo Then w = InputBox("请输入分隔字符", "单列合并输出")
   
10.     '如果单列输出时不需要分隔符，或把分隔符设置为固定字符串，那么这一句可以改成这样
    
11.     'If l = vbNo Then w = "" '不需要分隔符时
    
12.     'If l = vbNo Then w = "-" '固定设置为中杠或其它字符串时 (分隔符长度不限)   
    
13.     tms = Timer
    
14.    
    
15.     sj = [a1].CurrentRegion
    
16.     m = UBound(sj): n = UBound(sj, 2)
    
17.     k = 1
    
18.     For j = 1 To n
    
19.         For i = 1 To m
    
20.             If sj(i, j) = "" Then Exit For
    
21.         Next
    
22.         If i > m Then k = k * m Else k = k * i
    
23.     Next
    
24.    
    
25.     [a1].Offset(, n + 2).CurrentRegion = ""
    
26.     If l = vbYes Then '多列输出时
    
27.         ReDim jg(k, 1 To n)
    
28.         k = 0: Call dgMN(1)
    
29.         [a1].Offset(, n + 2).Resize(k, n) = jg
    
30.     Else '单列合并字符串输出时
    
31.         ReDim jg(k, 0)
    
32.         k = 0: Call dgMN1("", 1)
    
33.         [a1].Offset(, n + 2).Resize(k) = jg
    
34.     End If
    
35.     MsgBox Format(Timer - tms, "0.000s ") & k
    
36. End Sub
    
37. 
    
38. Sub dgMN(j&) '多列输出时的递归过程
    
39.     Dim i&, l&
    
40.     For i = 1 To m
    
41.         If sj(i, j) = "" Then
    
42.             Exit For
    
43.         Else
    
44.             jg(k, j) = sj(i, j)
    
45.             If j = n Then
    
46.                 For l = 1 To n
    
47.                     If jg(k, l) = "" Then jg(k, l) = jg(k - 1, l) Else Exit For
    
48.                 Next
    
49.                 k = k + 1
    
50.             Else
    
51.                 Call dgMN(j + 1)
    
52.             End If
    
53.         End If
    
54.     Next
    
55. End Sub
    
56. Sub dgMN1(s$, j&) '单列合并输出时的递归过程
    
57.     Dim i&
    
58.     For i = 1 To m
    
59.         If sj(i, j) = "" Then
    
60.             Exit For
    
61.         Else
    
62.             If j = n Then
    
63.                 jg(k, 0) = Mid(s & w & sj(i, j), Len(w) + 1): k = k + 1
    
64.             Else
    
65.                 Call dgMN1(s & w & sj(i, j), j + 1)
    
66.             End If
    
67.         End If
    
68.     Next
    
69. End Sub

复制代码

上面代码可以由用户自己选择输出【多列/或单列合并】方式。其实也很简单那。

风儿哦

好棒,根据自己的需求改成从每一行取一个元素,也运行成功了