楼主
芐雨 |
Q:如何按下面要求选数凑组合
1、在EXCEL中有三行数据，第一组A1——k1：1——11；第二组A2——k2：12——22；第三组A3——k3：23——33。
2、A4—C4由用户自由填入1~6的数字，要求A4+B4+C4=6。
3、D4和E4输入的数据要求为21<D4<E4<242。
4、分别从第一组取A4个数，第二组取B4个数，第三组取C4个数，形成6个数字组成的组合，并判断组合中的数相加是否大于D4小于E4格子的值，如果在此区间，则列出，如果不则忽略。如果一个组合都无法取得，则返回一个0。
问题引自百度：- http://zhidao.baidu.com/question/262540180239919285.html?oldq=1
A：代码如下- Sub Combin_芐雨()
- Dim arr, ar(), brr(), crr()
- '-------判断[A4:E4]是否适合要求------
- For i = 1 To 3
- If Cells(4, i) < 1 Or Cells(4, i) > 6 Or Cells(4, i) <> Int(Cells(4, i)) Then
- MsgBox Cells(4, i).Address(0, 0) & "=" & Cells(4, i) & "不在[1,6]整数区间内": Exit Sub
- End If
- Next
- If [A4] + [B4] + [C4] <> 6 Then
- MsgBox "单元格[A4:C4]之和不等于6 ": Exit Sub
- End If
- If [D4] <= 21 Or [E4] >= 242 Or [D4] > [E4] Then
- MsgBox "单元格[D4:E4]不符合要求(21<D4<E4<242) ": Exit Sub
- End If
- arr = Application.Transpose(Range("A1:K3"))
- cb = Application.Transpose(Range("A4:C4"))
- cb1 = Application.Combin(11, [A4]) '获取第一行的组合数
- cb2 = Application.Combin(11, [B4]) '获取第二行的组合数
- cb3 = Application.Combin(11, [C4]) '获取第二行的组合数
- t1 = [D4] '区域最小值
- t2 = [E4] '区域最大值
- [O:IV].Clear '消除区域
- cmax = Application.Max(cb1, cb2, cb3) '三行组合数最大值
- ReDim ar(1 To cmax, 1 To 6) '六维数组;1-3维储存组合形式，4-6维储存组合之和
- For i = 1 To 3 '循环单元格[A4:C4]
- x = 0
- Select Case Cells(4, i) '判断单元格[A4:C4]的值（因条件限制分别可能是：1，2，3，4）
- Case 1 '取1个数时
- For x = 1 To 11
- ar(x, i) = arr(x, i)
- ar(x, i + 3) = arr(x, i)
- Next
- Case 2 '取2个数时
- For m = 1 To 11 '利用循环遍历所有组合，下同
- For n = m + 1 To 11
- x = x + 1 '记录数
- ar(x, i) = arr(m, i) & "+" & arr(n, i) '组合形式
- ar(x, i + 3) = arr(m, i) + arr(n, i) '组合之和
- Next
- Next
- Case 3 '取3个数时，循环解释参考case2
- For m = 1 To 9
- For n = m + 1 To 10
- For b = n + 1 To 11
- x = x + 1
- ar(x, i) = arr(m, i) & "+" & arr(n, i) & "+" & arr(b, i)
- ar(x, i + 3) = arr(m, i) + arr(n, i) + arr(b, i)
- Next
- Next
- Next
- Case 4 '取4个数时，循环解释参考case2
- For m = 1 To 8
- For n = m + 1 To 9
- For b = n + 1 To 10
- For c = b + 1 To 11
- x = x + 1
- ar(x, i) = arr(m, i) & "+" & arr(n, i) & "+" & arr(b, i) & "+" & arr(c, i)
- ar(x, i + 3) = arr(m, i) + arr(n, i) + arr(b, i) + arr(c, i)
- Next
- Next
- Next
- Next
- End Select
- Next
- n = cb1 * cb2 * cb3 '实际组合数
- ReDim brr(1 To n, 1 To 2)
- x = 0 '初始化
- For i = 1 To cb1
- For j = 1 To cb2
- For k = 1 To cb3
- temp = ar(i, 4) + ar(j, 5) + ar(k, 6)
- If temp < t2 And temp > t1 Then '组合之和是否在区域内的值
- x = x + 1
- brr(x, 1) = temp '组合之和
- brr(x, 2) = ar(i, 1) & "+" & ar(j, 2) & "+" & ar(k, 3) '组合形式
- End If
- Next
- Next
- Next
- Select Case x '判断适合条件的组合数
- Case 0
- MsgBox "没有合适条件的组合"
- Case Is > Rows.Count '若组合数大于列的最大值，转为多维数组
- m = 1
- n = 1
- k = WorksheetFunction.RoundUp(x / Rows.Count, 0) * 2 ' 计算维数
- ReDim crr(1 To Rows.Count, 1 To k)
- For i = 1 To x
- crr(m, n) = brr(i, 1)
- crr(m, n + 1) = brr(i, 2)
- If i Mod Rows.Count = 0 Then '判断是否要转维
- m = 0: n = n + 2
- End If
- m = m + 1
- Next
- [O1].Resize(Rows.Count, k) = crr
- Case Else
- [O1].Resize(x, 2) = brr
- End Select
- [L7] = "组合数:"
- [M7] = x
- End Sub
附件：
 选数凑组合_芐雨.rar
|