Function prefer(a As Single, price As Single) As Single
Dim q As Single
Dim maxu As Single
Dim maxq As Single
Dim u1 As Single
maxu = u(a, 0)
maxq = 0
For q = 1 To 10
u1 = u(a, q) - price * q
If u1 > maxu Then maxq = q
If u1 > maxu Then maxu = u1
Next
prefer = maxq
End Function
Function u(a As Single, q As Single) As Single
Dim b As Single
b = 1
u = a * q - b * q ^ 2
End Function
Private Sub Command1_Click()
Dim price As Single
Dim cost As Single
Dim q As Single
Dim ps As Single
Dim p1 As Single
Dim p2 As Single
Dim h As Single
Dim rs As Single
Dim r1 As Single
Dim r2 As Single
Dim a As Single
a = 100
cost = 1
h = 1
ps = 3
p1 = ps + h
p2 = ps - h
price = ps
q = prefer(a, price)
rs = price * q - cost * q
Debug.Print rs
t = 0
Do Until t > 100
p1 = ps + h
p2 = ps - h
price = p1
q = prefer(a, price)
r1 = price * q - cost * q
price = p2
q = prefer(a, price)
r2 = price * q - cost * q
If r1 > rs Then ps = p1
If r1 > rs Then rs = r1
If r2 > rs Then ps = p2
If r2 > rs Then rs = r2
If px = ps Then t = 1000
px = ps
t = t + 1
Loop
Debug.Print ps, rs
End Sub
最終更新:2009年09月23日 01:53