|
发表于 2015-12-23 12:52
|
显示全部楼层
本楼为最佳答案
代码注释- Dim sj, jg(), i1&, m&, n&, k& '定义递归过程需调用的公用变量
- Sub test() 'by kagawa
- Dim ar, h&, i2&, j&, tms#
- tms = Timer '程序开始时间
-
- ar = [b5].CurrentRegion '读取原始数据到数组ar
- n = UBound(ar, 2) '得到展开列数n
-
- h = [d1] '读取D1限制最大值h
- m = h \ 10 '计算累计+10需要的最大行数m
- k = UBound(ar) * (m + 1) ^ n '估计全部组合个数k
- ReDim jg(k, n): k = 0 '定义存放组合结果的数组jg、并初始化记录位置k
- For i1 = 1 To UBound(ar) '遍历原始数据各行
- ReDim sj(m, n) '矩阵数组sj初始化
- For i2 = 0 To m '各行累计+10直到限额
- For j = 1 To n '各列+10处理
- If ar(i1, j) < h - 10 * i2 Then sj(i2, j) = ar(i1, j) + 10 * i2 '不超限额时+10
- Next
- Next
- Call dgMN(1) '调用【香川多列组合】的递归算法过程
- Next
- [b5].Offset(, n + 1).CurrentRegion.Offset(1) = "" '清空输出区域
- [b5].Offset(, n + 1).Resize(k, n + 1) = jg '输出结果
- MsgBox Format(Timer - tms, "0.00s ") & k '提示程序耗时 和 结果总数k
- End Sub
- Sub dgMN(j&) '【香川多列组合】的递归算法过程
- Dim i&, l&, t
- For i = 0 To m '遍历数据矩阵sj各行
- t = sj(i, j) '读取该位置数值t
- If t = "" Then Exit For '如为空(超过限额)则退出
- If t > jg(k, j - 1) Then '如比左侧数据大则有效(排除无效组合)
- jg(k, j) = t '写入此数值t
- If j = n Then '如已到组合最后1列(满足组合列数=n)
- jg(k, 0) = i1 '记录该组合的原始数据行序号
- k = k + 1 '组合记录位置k+1
- For l = 1 To n - 1 '复制该组合数据到下一组
- jg(k, l) = jg(k - 1, l)
- Next
- Else
- Call dgMN(j + 1) '不足n列时继续深入递归去组合下1列
- End If
- End If
- Next
- End Sub
复制代码 |
|