最近遇到的排列组合问题

Kelidai

最近做自动排程，遇到了排列组合的问题，类似m行n列的排列组合问题，就是各列的数据全部排列起来，（相当于每列排好后再统一排起来）。
每列的行数可能不同，请各位高手帮忙看看。
模拟如下：


排列组合.zip (12.8 KB, 下载次数: 15)

2015-5-18 10:33 上传

点击文件名下载附件

liulang0808

m,n
多不多，类似上图的，用三层for循环可以解决的

Kelidai

liulang0808 发表于 2015-5-18 10:06
m,n
多不多，类似上图的，用三层for循环可以解决的

m,n都是不确定的，背景是我们将一批订单安排在不同的产线上，订单数量，工序都有都不固定。
求出所有可能的排列组合后，找出比较好的排程方案。

香川群子

1. 没有附件。

2. 问题太笼统，无法判断你的最终目的。

Kelidai

香川群子 发表于 2015-5-18 10:27
1. 没有附件。

2. 问题太笼统，无法判断你的最终目的。

群子老师，附件已经加上了。

liulang0808

Kelidai 发表于 2015-5-18 10:17
m,n都是不确定的，背景是我们将一批订单安排在不同的产线上，订单数量，工序都有都不固定。
求出所有可 ...

查查 香川群子 老师的帖子吧
之前有过类似问题处理的

lt0314

1. Public sj, jg(), m, n, r
   
2. Sub 香川组合递归()
   
3.     sj = ActiveCell.CurrentRegion: m = UBound(sj): n = UBound(sj, 2): Amn = m ^ n
   
4.     If Amn > 65536 Then Exit Sub Else r = 0   'ReDim jg(Amn, 0)
   
5.     Call mndg("", 0, 0, "")
   
6.     ActiveCell.CurrentRegion.Cells(1).Offset(m + 3, n).Resize(r) = WorksheetFunction.Transpose(jg)
   
7. End Sub
   
8. Sub mndg(s$, i, t%, ts$)
   
9.     If t = n Then
   
10.         p = Split(s, ";")
    
11.         ReDim Preserve jg(r)
    
12.         For j = 1 To n
    
13.             If sj(p(j), j) <> "" Then ts = ts & ";" & sj(p(j), j) Else Exit Sub
    
14.         Next
    
15.         jg(r) = Mid(ts, 2): r = r + 1: Exit Sub
    
16.     End If
    
17.     For j = i + 1 To m
    
18.         Call mndg(s & ";" & j, 0, t + 1, "")
    
19.     Next j
    
20. End Sub

复制代码

香川群子

首先各列元素进行全排列，
然后进行香川多列组合，得到最后结果。

所以一共需要两个不同的递归过程：

1. Dim sj(), jg(), j&, k&, n&
   
2. Sub test() 'by kagawa 2015/5/18
   
3.     Dim ar, i&, m&, s$, cnt&, tms#
   
4.     tms = Timer
   
5.     ar = [a1].CurrentRegion
   
6.     n = UBound(ar, 2)
   
7.    
   
8.     cnt = 1
   
9.     ReDim sj(1 To n, -1 To 0)
   
10.     For j = 1 To n
    
11.         s = ""
    
12.         For i = 1 To UBound(ar)
    
13.             If ar(i, j) = "" Then Exit For
    
14.             s = s & ar(i, j) '各列元素合并为字符串s
    
15.         Next
    
16.         k = WorksheetFunction.Fact(Len(s)) '计算各列排列结果数
    
17.         sj(j, 0) = s: sj(j, -1) = k
    
18.         If k > m Then m = k '得到各列排列结果的最大值
    
19.         cnt = cnt * k
    
20.     Next
    
21.    
    
22.     ReDim Preserve sj(1 To n, -1 To m) '按最大值m定义数组sj存放各列排列结果
    
23.     For j = 1 To n
    
24.         k = 0: Call dgPL("", CStr(sj(j, 0)), Len(sj(j, 0))) '调用全排列递归过程
    
25.     Next
    
26.    
    
27.     ReDim jg(1 To cnt, 1 To 1) '定义存放香川多列组合的结果数组
    
28.     k = 0: Call dgMN("", 1) '调用香川多列组合递归过程
    
29.    
    
30.     MsgBox Format(Timer - tms, "0.000s ") & k
    
31.     [a1].Offset(, n + 1).CurrentRegion = ""
    
32.     [a1].Offset(, n + 1).Resize(k) = jg '输出结果
    
33. End Sub
    
34. 
    
35. Sub dgPL(x$, y$, n&) '各列元素进行全排列交换的递归过程
    
36.     Dim i&
    
37.     If n = 1 Then k = k + 1: sj(j, k) = x & y: Exit Sub
    
38.     For i = 1 To n
    
39.         Call dgPL(x & Mid(y, i, 1), Left(y, i - 1) & Right(y, n - i), n - 1)
    
40.     Next
    
41. End Sub
    
42. 
    
43. Sub dgMN(s$, j&) '各列排列结果进行香川多列组合的递归过程
    
44.     Dim i&
    
45.     For i = 1 To sj(j, -1)
    
46.         If j < n Then Call dgMN(s & sj(j, i), j + 1) Else k = k + 1: jg(k, 1) = s & sj(j, i)
    
47.     Next
    
48. End Sub
    

复制代码

香川群子

按每一个元素一个单元格进行多行多列数组输出的代码。

这个比直接合并字符串处理要复杂。

Kelidai

香川群子 发表于 2015-5-18 13:18
按每一个元素一个单元格进行多行多列数组输出的代码。

这个比直接合并字符串处理要复杂。

已经解决了我的问题。非常感谢！