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

香川群子

WebConNum 发表于 2013-7-21 19:39
香川大师：

在原始数据前加分隔符的方法是可以的,我已经试过了;

jg(k, 1) = Mid(s,Len("分隔符")) '输出结果

这句错了。
应该是
jg(k, 1) = Mid(s,1 + Len("分隔符")) '输出结果

Mid处理位置必须从1开始而不是从0开始。

WebConNum

大师出手,果然不凡!

香川大师,真的非常感谢你! {:soso_e179:}

WebConNum

香川大师,你好!

有一个新问题想再次得到你的帮助。呵呵,得寸进寸哦...

详见附件

香川群子

WebConNum 发表于 2013-7-23 07:42
香川大师,你好!

有一个新问题想再次得到你的帮助。呵呵,得寸进寸哦...

直接上代码。

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

即，m行、n列的元素中，依次从各列中取一个元素组成的n元素组合。


这个问题用递归做特别简单：

1. Dim sj(), jg$(), n&, k&
   
2. Sub KagawaCombin()
   
3.    
   
4.     sj0 = Split([a1], "+")
   
5.     n = UBound(sj0)
   
6.     ReDim sj(n, Len([a1]))
   
7.     k = 1
   
8.     For i = 0 To n
   
9.         s = sj0(i)
   
10.         l = Len(s)
    
11.         If l > m Then m = l
    
12.         sj(i, 0) = l
    
13.         k = k * l
    
14.         For j = 1 To l
    
15.             sj(i, j) = Mid(s, j, 1)
    
16.         Next
    
17.     Next
    
18.     ReDim Preserve sj(n, m)
    
19.     ReDim jg$(1 To k, 1 To 1)
    
20.    
    
21.     k = 0: Call dgMN("", 0)
    
22.    
    
23.     [c1].CurrentRegion = ""
    
24.     [c1].Resize(k) = jg
    
25.     MsgBox Format(Timer - tms, "0.000s ") & k
    
26. End Sub
    
27. 
    
28. Sub dgMN(s$, i&)
    
29.     If i = n + 1 Then k = k + 1: jg(k, 1) = Mid(s, 2): Exit Sub
    
30.     For j = 1 To sj(i, 0)
    
31.         Call dgMN(s & "+" & sj(i, j), i + 1)
    
32.     Next
    
33. End Sub
    

复制代码

香川群子

补上附件。

香川群子

典型【香川列组合】 的代码和实例：

1. Dim sj, jg$(), m&, n&, k&
   
2. Sub KagawaCombinArea()
   
3.     tms = Timer
   
4.     sj = [a1].CurrentRegion
   
5.     m = UBound(sj): n = UBound(sj, 2)
   
6.    
   
7.     k = 1
   
8.     For j = 1 To n
   
9.         For i = m To 1 Step -1
   
10.             If sj(i, j) <> "" Then k = k * i: Exit For
    
11.         Next
    
12.     Next
    
13.     ReDim jg$(k, 1)
    
14. 
    
15.     k = 0: Call dgMN("", "", 1)
    
16.    
    
17.     MsgBox Format(Timer - tms, "0.000s ") & k
    
18.    
    
19.     If k > Rows.Count Then Exit Sub
    
20.     With Cells(1, 1).Offset(m + 5)
    
21.         .CurrentRegion = ""
    
22.         .Resize(k, 2) = jg
    
23.         .Resize(, 2).EntireColumn.AutoFit
    
24.     End With
    
25.    
    
26. End Sub
    
27. 
    
28. Sub dgMN(r$, s$, j&)
    
29.     Dim i&
    
30.     For i = 1 To m
    
31.         If sj(i, j) <> "" Then
    
32.             If j < n Then
    
33.                 Call dgMN(r & sj(i, j), s & "," & sj(i, j), j + 1)
    
34.             Else
    
35.                 jg(k, 0) = r & sj(i, j)
    
36.                 jg(k, 1) = Mid(s, 2) & "," & sj(i, j)
    
37.                 k = k + 1
    
38.             End If
    
39.         End If
    
40.     Next
    
41. End Sub
    
42. 
    

复制代码

WebConNum

再谢香川大师！ {:soso_e179:}

foxy617

next后边的变量还可以这样写啊，我都是1个next写一行的，学习了

yf_home

强,支持一下,跟贴学习.
有好多都不是很懂,要慢慢琢磨了.

sujer

好犀利!顶一个