|
![](https://clubstatic.excelhome.net/image/common/ico_lz.png)
楼主 |
发表于 2003-10-10 18:53
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
没有错,用我以下的程序可以列出94种切分方案:
Sub ccc()
Dim 元素数() As Integer, 最大列, 总行, i, j, k0, k, maxcell As Integer
Dim 单元数() As Integer
Dim 单元大小() As Integer
Dim 单元重复系数() As Integer
Dim 单元() As Integer
Dim 总表() As Integer
Dim 子表() As Integer
Dim zs, s0 As String
Dim xialiao
Dim zuiduan
Dim sz
总行 = 1
dingchi = 2000
s = "101,201,301,401"
xialiao = Split(s, ",", -1, vbTextCompare)
最大列 = UBound(xialiao)
ReDim 元素数(最大列)
ReDim 单元数(最大列)
ReDim 单元大小(最大列)
ReDim 单元重复系数(最大列)
zuiduan = xialiao(1)
For j = 0 To 最大列
元素数(j) = Int(dingchi / xialiao(j)) + 1
总行 = 总行 * 元素数(j)
Next
ReDim 总表(1 To 总行, 0 To 最大列)
For i = 最大列 To 0 Step -1
If i = 最大列 Then
单元重复系数(最大列) = 1
Else
单元重复系数(i) = 单元重复系数(i + 1) * 元素数(i + 1)
End If
单元大小(i) = 单元重复系数(i) * 元素数(i)
If maxcell < 单元大小(i) Then maxcell = 单元大小(i)
单元数(i) = 总行 / 单元大小(i)
If zuiduan > xialiao(i) Then zuiduan = xialiao(i)
Next
ReDim 单元(0 To 最大列, 1 To maxcell)
For i = 0 To 最大列
k0 = 0
For j = 1 To 元素数(i)
For k = 1 To 单元重复系数(i)
k0 = k0 + 1
单元(i, k0) = j - 1
Next
Next
Next
For i = 0 To 最大列
k0 = 0
For j = 1 To 单元数(i)
For k = 1 To 单元大小(i)
k0 = k0 + 1
总表(k0, i) = 单元(i, k)
Next
Next j
Next
Rem 求符合条件的子集
k = 0
For i = 1 To 总行
k0 = 0
k = k + 1
ReDim Preserve 子表(最大列, k)
For j = 0 To 最大列
子表(j, k) = 总表(i, j)
k0 = k0 + 总表(i, j) * xialiao(j)
If k0 > dingchi Then
k = k - 1
ReDim Preserve 子表(最大列, k)
GoTo logo1
End If
Next
If k0 <= dingchi - zuiduan Then
k = k - 1
ReDim Preserve 子表(最大列, k)
End If
logo1:
Next
For x = 1 To k
s = ""
For i = 0 To 最大列
Cells(x, i + 1) = 子表(i, x)
Next
Next
End Sub |
|