３ ３ ３ ３ - プログラム倉庫

Function rev(ax, price As Single) As Single
Dim n As Single
Dim a As Single
Dim cost As Single
Dim r1 As Single
r1 = 0
For n = 1 To 2
a = ax(n)
cost = 1
q = prefer(a, price)
r1 = r1 + price * q - cost * q
Next
rev = r1
End Function


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 50
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
Dim ax(1 To 2) As Single
ax(1) = 100
ax(2) = 90
a = 100
cost = 1
h = 1
ps = 3
p1 = ps + h
p2 = ps - h
price = ps
rs = rev(ax, price)
Debug.Print rs
t = 0
Do Until t > 100
p1 = ps + h
p2 = ps - h
price = p1
r1 = rev(ax, price)
price = p2
r2 = rev(ax, price)
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