请问老师如何用VBA实现这个规划求解怎么？？谢谢

杨柳依 · 发表于 2011-4-22 12:27

请教老师：
a*X+b*Y+c*Z<10的解，满足以下条件：
1.a,b,c是0或正整数，且a+b+c=3
2.X,Y,Z是取自工作表中A1:B2的数值（正整数）
求：
1.所有符合条件的a*X,b*Y,c*Z的组合
2.满足条件的最优条件的a*X,b*Y,c*Z组合
谢谢老师

gufengaoyue · 发表于 2011-4-22 12:53

Sub 按钮1_Click()
Dim arr As Range, r
Set arr = Range("a1:b2")
Dim a%, b%, c%, X, Y, Z
r = 2
Cells(r, 3) = ""
For a = 0 To 3
For b = 0 To 3
For c = 0 To 3
If a + b + c = 3 Then
For Each X In arr
For Each Y In arr
For Each Z In arr
If a * X + b * Y + c * Z < 10 Then
S = a & "*" & X & "+" & b & "*" & Y & "+" & c & "*" & Y & "<10"
If Cells(r - 1, 3) <> S Then
Cells(r, 3) = a & "*" & X & "+" & b & "*" & Y & "+" & c & "*" & Y & "<10"
r = r + 1
End If
End If
Next
Next
Next
End If
Next
Next
Next
End Sub

复制代码

[ 本帖最后由 gufengaoyue 于 2011-4-22 13:20 编辑 ]

lizi007 · 发表于 2011-4-22 12:58

，方法不错，有代码之美！

杨柳依 · 发表于 2011-4-22 13:01

谢谢老师的代码，请问老师，这个问题能不能用工作表里的规划求解对话框直接做？？还请老师赐教

gufengaoyue · 发表于 2011-4-22 13:13

原帖由 lizi007 于 2011-4-22 12:58 发表
，方法不错，有代码之美！

只是按一般思路写的
太多循环，如果数据量大的话，就会非常慢
这个也只是适用楼主的要求而已

杨柳依 · 发表于 2011-4-22 14:45

就是，我那个数据有10列x20行，而且是 a*X+b*Y+c*Z+d*T<10,a,bcd之和为7，那么半天

灰袍法师 · 发表于 2011-4-23 00:19

2楼代码有两个致命的缺陷

1 if aX+bY+cZ<10 放在了循环的最内层，这样一来就一定要穷举所有组合（包括了绝大多数 >=10的组合，以及a+b+c>3的组合）

应该这样做，连 if 判断都不需要了
remain = 10:count=3
for a = 0 to [int( remain / X ), count] '取中括号的较小值
remain = remain - a * X
count = count - a
  for b = 0 to [ int( remain / Y ), count ] '取中括号的较小值
   remain = remain - b * Y
   count = count - b
.......

另外，应该把结果放入数组，最后才一次性写入工作表，否则碰到上万个结果的时候就会很慢。

[ 本帖最后由灰袍法师于 2011-4-23 00:30 编辑 ]

杨柳依 · 发表于 2011-4-23 17:48

老师，快看7楼，算法优化了

杨柳依 · 发表于 2011-4-23 17:46

好东东，谢谢老师，我的计算时间少了许多

		自动登录	找回密码
密码			免费注册

[求助] 请问老师如何用VBA实现这个规划求解怎么？？谢谢

回复 2楼 gufengaoyue 的帖子

回复 5楼 gufengaoyue 的帖子

回复 2楼 gufengaoyue 的帖子

回复 7楼灰袍法师的帖子

[求助] 请问老师如何用VBA实现这个规划求解怎么？？谢谢

回复 2楼 gufengaoyue 的帖子

回复 5楼 gufengaoyue 的帖子

回复 2楼 gufengaoyue 的帖子

回复 7楼 灰袍法师 的帖子

回复 7楼灰袍法师的帖子