money monet - プログラム倉庫

Private Sub Command1_Click()
Dim ks As Single
Dim a As Single
Dim beta As Single
Dim r1 As Single
Dim n As Single
Dim cx(1 To 100) As Single
Dim cp(1 To 100) As Single
Dim k(1 To 100) As Single
Dim h As Single
Dim k1 As Single
Dim n1 As Single
Dim n2 As Single
Dim n3 As Single
Dim c1 As Single
Dim e As Single
beta = 0.95
a = 0.33
r1 = 1 / beta - 1
ks = (r1 / a) ^ (1 / (a - 1))
h = 2 * ks / 100
For n = 1 To 100
k(n) = n * h
cx(n) = k(n) ^ a
Next
t1 = 0
Do Until t1 > 100
For n = 10 To 90
k1 = k(n) + k(n) ^ a - cx(n)
n1 = k1 / h
n2 = Int(n1)
n3 = n2 + 1
c1 = cx(n2) + (n1 - n2) * (cx(n3) - cx(n2))
r1 = a * k1 ^ (a - 1)
cp(n) = c1 / (beta * (1 + r1))
Next
e = 0
For n = 10 To 90
e = e + (cx(n) - cp(n)) ^ 2
Next
For n = 10 To 90
cx(n) = cp(n)
Next
If e < 10 ^ (-5) Then t1 = 1000
t1 = t1 + 1
Loop
Dim px(1 To 100) As Single
Dim ps(1 To 100) As Single
Dim ms As Single
ms = 20
For n = 1 To 100
px(n) = 1
Next
t2 = 0
Do Until t2 > 100
For n = 10 To 90
p1 = px(n) + 0.01
p2 = px(n) - 0.01
k1 = k(n) + k(n) ^ a - cx(n)
r1 = a * k1 ^ (a - 1)
n1 = k(n) / h
n2 = Int(n1)
n3 = n2 + 1
pp = (px(n2) + (n1 - n2) * (px(n3) - px(n2))) / p1
i1 = pp * (1 + r1) - 1
z1 = (ms * i1) / (cx(n) * (1 + i1)) - p1
t = 0
Do Until t > 100
pp = (px(n2) + (n1 - n2) * (px(n3) - px(n2))) / p2
i1 = pp * (1 + r1) - 1
z2 = (ms * i1) / (cx(n) * (1 + i1)) - p2
p3 = p2 - z2 * (p2 - p1) / (z2 - z1)
If (z2) ^ 2 < 10 ^ (-5) Then t = 1000
p1 = p2
p2 = p3
z1 = z2
t = t + 1
Loop
ps(n) = p2
Next
e = 0
For n = 10 To 90
e = e + (px(n) - ps(n)) ^ 2
Next
For n = 10 To 90
px(n) = ps(n)
Next
Debug.Print t2, e
If e < 10 ^ (-5) Then t2 = 1000
t2 = t2 + 1
Loop
For n = 10 To 90
Debug.Print n, px(n)
Next

End Sub