Excel规划求解求哪几个数字之和等于一个固定值
最新回答
玉容花见羞
2022-06-02 01:19:02
1、在B8单元格输入=SUMPRODUCT(A1:A7,B1:B7)
2、在“数据”选项下的“规划求解”中，按下图设置，“求缺掘解”后，即可伏液核得到B列为1标记的对应埋档数。
初心不负
2021-01-14 12:33:16
1年前写过渣态一段代码贴在这里供有缘人查看。
Const fz0 = 2 '起始分组值
Sub beibao() '分扰梁磨组查找，保证元素均匀分布
Dim SJ()
Dim gs, I, J As Integer
Dim fz
Dim fzjs()
Dim bj As Integer '记录有无结果
Dim h1, h2 As Long
Dim Hzz, Lzz As Long '输出行、列指针
Dim QCgs As Integer '清除的个数
Dim ss As Double '存放合计数
Hzz = 2: Lzz = 6
Sheets("SHEET2").Select
Range("F2：X100").ClearContents
h1 = Cells(1, 4)
h2 = Cells(2, 4)
I = Range("b100").End(xlUp).Row - 1 '统计个数
gs = I
ReDim SJ(1 To I, 1 To 3) '1-数值 2-组别 3-已加入标记
ReDim SJ2(1 To I, 1 To 3) '清理前备份
For J = 1 To I
SJ(J, 1) = Cells(J + 1, 2)
Next J
fz = fz0
200 Do While fz <= gs
bj = 0 '是否找到组合缓斗标记
'对数据进行分组 分组组合的目的是为了均匀化
For J = 1 To gs
K = Int(J / (gs / fz)) + 1
If K > fz Then K = fz '多于的全部算在最后一组
SJ(J, 2) = K
Next J
'计算每组个数
ReDim fzjs(1 To fz) '计算每组的个数
For J = 1 To gs
fzjs(SJ(J, 2)) = fzjs(SJ(J, 2)) + 1
Next J
Select Case fz
Case 2
For p1 = 1 To fzjs(1)
For p2 = 1 To fzjs(2)
ss = SJ(p1, 1) + SJ(p2 + fzjs(1), 1)
If ss >= h1 And ss <= h2 Then
SJ(p1, 3) = 1: SJ(p2 + fzjs(1), 3) = 1: bj = 1: GoTo 100
End If
Next p2
Next p1
Case 3
For p1 = 1 To fzjs(1)
For p2 = 1 To fzjs(2)
For p3 = 1 To fzjs(3)
ss = SJ(p1, 1) + SJ(p2 + fzjs(1), 1) + SJ(p3 + fzjs(1) + fzjs(2), 1)
If ss >= h1 And ss <= h2 Then
SJ(p1, 3) = 1: SJ(p2 + fzjs(1), 3) = 1: SJ(p3 + fzjs(1) + fzjs(2), 3) = 1: bj = 1: GoTo 100
End If
Next p3
Next p2
Next p1
Case 4
For p1 = 1 To fzjs(1)
For p2 = 1 To fzjs(2)
For p3 = 1 To fzjs(3)
For p4 = 1 To fzjs(4)
ss = SJ(p1, 1) + SJ(p2 + fzjs(1), 1) + SJ(p3 + fzjs(1) + fzjs(2), 1) + SJ(p4 + fzjs(1) + fzjs(2) + fzjs(3), 1)
If ss >= h1 And ss <= h2 Then
SJ(p1, 3) = 1: SJ(p2 + fzjs(1), 3) = 1: SJ(p3 + fzjs(1) + fzjs(2), 3) = 1
SJ(p4 + fzjs(1) + fzjs(2) + fzjs(3), 3) = 1: bj = 1: GoTo 100
End If
Next p4
Next p3
Next p2
Next p1
Case 5
For p1 = 1 To fzjs(1)
For p2 = 1 To fzjs(2)
For p3 = 1 To fzjs(3)
For p4 = 1 To fzjs(4)
For p5 = 1 To fzjs(5)
ss = SJ(p1, 1) + SJ(p2 + fzjs(1), 1) + SJ(p3 + fzjs(1) + fzjs(2), 1) + SJ(p4 + fzjs(1) + fzjs(2) + fzjs(3), 1) + SJ(p5 + fzjs(1) + fzjs(2) + fzjs(3) + fzjs(4), 1)
If ss >= h1 And ss <= h2 Then
SJ(p1, 3) = 1: SJ(p2 + fzjs(1), 3) = 1: SJ(p3 + fzjs(1) + fzjs(2), 3) = 1
SJ(p4 + fzjs(1) + fzjs(2) + fzjs(3), 3) = 1
SJ(p5 + fzjs(1) + fzjs(2) + fzjs(3) + fzjs(4), 3) = 1
bj = 1: GoTo 100
End If
Next p5
Next p4
Next p3
Next p2
Next p1
Case 6
For p1 = 1 To fzjs(1)
For p2 = 1 To fzjs(2)
For p3 = 1 To fzjs(3)
For p4 = 1 To fzjs(4)
For p5 = 1 To fzjs(5)
For p6 = 1 To fzjs(6)
ss = SJ(p1, 1) + SJ(p2 + fzjs(1), 1) + SJ(p3 + fzjs(1) + fzjs(2), 1) + SJ(p4 + fzjs(1) + fzjs(2) + fzjs(3), 1) + SJ(p5 + fzjs(1) + fzjs(2) + fzjs(3) + fzjs(4), 1)
ss = ss + SJ(p6 + fzjs(1) + fzjs(2) + fzjs(3) + fzjs(4) + fzjs(5), 1)
If ss >= h1 And ss <= h2 Then
SJ(p1, 3) = 1: SJ(p2 + fzjs(1), 3) = 1: SJ(p3 + fzjs(1) + fzjs(2), 3) = 1
SJ(p4 + fzjs(1) + fzjs(2) + fzjs(3), 3) = 1
SJ(p5 + fzjs(1) + fzjs(2) + fzjs(3) + fzjs(4), 3) = 1
SJ(p6 + fzjs(1) + fzjs(2) + fzjs(3) + fzjs(4) + fzjs(5), 3) = 1
bj = 1: GoTo 100
End If
Next p6
Next p5
Next p4
Next p3
Next p2
Next p1
Case 7
For p1 = 1 To fzjs(1)
For p2 = 1 To fzjs(2)
For p3 = 1 To fzjs(3)
For p4 = 1 To fzjs(4)
For p5 = 1 To fzjs(5)
For p6 = 1 To fzjs(6)
For p7 = 1 To fzjs(7)
ss = SJ(p1, 1) + SJ(p2 + fzjs(1), 1) + SJ(p3 + fzjs(1) + fzjs(2), 1) + SJ(p4 + fzjs(1) + fzjs(2) + fzjs(3), 1) + SJ(p5 + fzjs(1) + fzjs(2) + fzjs(3) + fzjs(4), 1)
ss = ss + SJ(p6 + fzjs(1) + fzjs(2) + fzjs(3) + fzjs(4) + fzjs(5), 1)
ss = ss + SJ(p7 + fzjs(1) + fzjs(2) + fzjs(3) + fzjs(4) + fzjs(5) + fzjs(6), 1)
If ss >= h1 And ss <= h2 Then
SJ(p1, 3) = 1: SJ(p2 + fzjs(1), 3) = 1: SJ(p3 + fzjs(1) + fzjs(2), 3) = 1
SJ(p4 + fzjs(1) + fzjs(2) + fzjs(3), 3) = 1
SJ(p5 + fzjs(1) + fzjs(2) + fzjs(3) + fzjs(4), 3) = 1
SJ(p6 + fzjs(1) + fzjs(2) + fzjs(3) + fzjs(4) + fzjs(5), 3) = 1
SJ(p7 + fzjs(1) + fzjs(2) + fzjs(3) + fzjs(4) + fzjs(5) + fzjs(6), 3) = 1
bj = 1: GoTo 100
End If
Next p7
Next p6
Next p5
Next p4
Next p3
Next p2
Next p1
End Select
100 If bj = 1 Then
'输出背包值后，清除已分配值
Cells(Hzz, Lzz) = fz: Cells(Hzz, Lzz + 1) = ss
For J = 1 To gs
If SJ(J, 3) = 1 Then
Cells(Hzz, Lzz + 1 + 1) = SJ(J, 1)
Lzz = Lzz + 1
End If
Next J
Hzz = Hzz + 1 '行指针+1
QCgs = Lzz - 6 '被清除的个数
Lzz = 6 '列指针还原
'重新整理数组sj
'STEP1 数据备份
For J = 1 To gs
SJ2(J, 1) = SJ(J, 1)
SJ2(J, 2) = SJ(J, 2)
SJ2(J, 3) = SJ(J, 3)
Next J
'step2 对数组sj重新整理，剔除已选择的
ReDim SJ(1 To gs - QCgs, 1 To 3) '1-数值 2-组别 3-已加入标记
K = 1
For J = 1 To gs
If SJ2(J, 3) <> 1 Then
SJ(K, 1) = SJ2(J, 1): SJ(K, 2) = SJ2(J, 2)
K = K + 1
End If
Next J
gs = gs - QCgs '最新个数扣除清除掉的
fz = fz0 '重新从2个分组开始匹配
GoTo 200
Else
fz = fz + 1
GoTo 200
End If
Loop
Call BJ_MARK
End Sub
Sub BJ_MARK()
Dim I, J, K, L, M As Integer
Dim SZ As Double '存放输出的数值
Dim Hzz As Integer
I = Range("b100").End(xlUp).Row - 1 '统计个数
Hzz = Range("f100").End(xlUp).Row
ReDim SJ(1 To I, 1 To 3)
For J = 1 To I '对SJ初始化
SJ(J, 1) = Cells(J + 1, 1)
SJ(J, 2) = Cells(J + 1, 2)
Next J
J = Range("F100").End(xlUp).Row '输出的最后行号
For K = 2 To J
L = 7
Do While Cells(K, L) > 0
For M = 1 To I '查找做标记
If SJ(M, 3) <> 1 And SJ(M, 2) = Cells(K, L) Then
SJ(M, 3) = 1
Exit For
End If
Next M
L = L + 1
Loop
Next K
'将未找到的数值输出到Hzz指定位置
Cells(Hzz + 1, 6) = "未找到的数据"
Cells(Hzz + 2, 6) = "序号"
Cells(Hzz + 2, 7) = "重量"
Hzz = Hzz + 3
For M = 1 To I '查找做标记
If SJ(M, 3) <> 1 Then
Cells(Hzz, 6) = SJ(M, 1)
Cells(Hzz, 7) = SJ(M, 2)
Hzz = Hzz + 1
End If
Next M
End Sub
热门标签
