Function gen(ystart As Single, mjk, fjk, mtime, ftime, jyo, macro, kaky) As Single
Dim year As Single
Dim age As Single
g1 = 0
For year = 5 To 99
age = 100 + year - ystart
h = 1
If age > 99 Then h = 0
If age > 99 Then age = 99
If age < 60 Then h = 0
If age < 60 Then age = 60
g2 = exp(year, age, mjk, fjk, mtime, ftime, jyo, macro, kaky)
If h = 0 Then g2 = 0
g1 = g1 + g2 / (1 + 0.032) ^ (year - 5)
Next
gen = Int(g1 / 10 ^ 2) / 10 ^ 2
End Function
Function exp(year As Single, age As Single, mjk, fjk, mtime, ftime, jyo, macro, kaky) As Single
Dim p1 As Single
Dim m1 As Single
Dim p2 As Single
Dim f1 As Single
Dim e1 As Single
e1 = 0
p1 = mpen(year, age, mtime, jyo, macro, kaky)
m1 = mjk(year, age)
p2 = fpen(year, age, ftime, jyo, macro)
f1 = fjk(year, age)
e1 = e1 + p1 * m1 + p2 * f1
exp = e1
End Function
Function fpen(year As Single, age As Single, ftime, jyo, macro) As Single
Dim y1 As Integer
Dim y2 As Integer
Dim y3 As Integer
Dim t1 As Single
Dim w2 As Single
Dim j1 As Single
Dim j2 As Single
Dim m1 As Single
Dim m2 As Single
Dim m3 As Single
Dim g As Single
Dim s1 As Single
s1 = 1
g = 0.021
y1 = year - age + 100
y2 = y1 + 65 - 100
For yp = 5 To y2
s1 = s1 * (1 + g)
Next
y3 = y2 + 1
If y3 < 5 Then y3 = 5
For yp = y3 To year
s1 = s1 * (1 + g + macro(yp))
Next
t1 = 12 * ftime(y1)
w2 = 1.3 * 21
j1 = jyo(y1) / 1000
If y1 < 46 Then j1 = 1.05 * j1
m2 = w2 * j1 * t1 * s1
m1 = 80 * s1 * ftime(y1) / 40
a1 = 60
If y1 > 45 Then a1 = 61
If y1 > 47 Then a1 = 62
If y1 > 49 Then a1 = 63
If y1 > 51 Then a1 = 64
If y1 > 53 Then a1 = 65
If age < a1 Then m1 = 0
If age > 64 Then m1 = 80 * s1 * ftime(y1) / 40
fpen = m1 + m2
End Function
Function mpen(year As Single, age As Single, mtime, jyo, macro, kaky) As Single
Dim y1 As Single
Dim t1 As Single
Dim w2 As Single
Dim j1 As Single
Dim j2 As Single
Dim m1 As Single
Dim m2 As Single
Dim m3 As Single
Dim g As Single
Dim s1 As Single
s1 = 1
g = 0.021
y1 = year - age + 100
y2 = y1 + 65 - 100
For yp = 5 To y2
s1 = s1 * (1 + g)
Next
y3 = y2 + 1
If y3 < 5 Then y3 = 5
For yp = y3 To year
s1 = s1 * (1 + g + macro(yp))
Next
t1 = 12 * mtime(y1)
t1 = 12 * mtime(y1)
w2 = 1.8 * 24
j1 = jyo(y1) / 1000
If y1 < 46 Then j1 = 1.05 * j1
m2 = w2 * j1 * t1 * s1
m1 = 80 * s1 * mtime(y1) / 40
a1 = 60
If y1 > 40 Then a1 = 61
If y1 > 42 Then a1 = 62
If y1 > 44 Then a1 = 63
If y1 > 46 Then a1 = 64
If y1 > 48 Then a1 = 65
If age < a1 Then m1 = 0
If age > 64 Then m1 = 80 * s1 * mtime(y1) / 40
m3 = 22.86 * kaky(age) * s1
mpen = m1 + m2 + m3
End Function
Private Sub Command1_Click()
Dim year As Single
Dim age As Single
Dim y1 As Integer
Dim a1 As Single
Dim a2 As Single
Dim a3 As Single
Dim a4 As Single
Dim a5 As Single
Dim mtime(0 To 140) As Single
Dim ftime(0 To 140) As Single
Dim mjk(-5 To 99, 0 To 99) As Single
Dim fjk(-5 To 99, 0 To 99) As Single
Dim mw(-5 To 99, 60 To 65) As Single
Dim fw(-5 To 99, 60 To 65) As Single
Dim jyo(0 To 199) As Single
Dim macro(0 To 99) As Single
Dim kaky(60 To 100) As Single
Open "c:/simple/gdata/女子老齢年金加入年数.txt " For Input As #7
Do Until EOF(7)
Input #7, a1, a2
year = a1
ftime(year) = a2
Loop
Close #7
Open "c:/simple/gdata/男子老齢年金加入年数.txt " For Input As #77
Do Until EOF(77)
Input #77, a1, a2
year = a1
mtime(year) = a2
Loop
Close #77
Open "c:/simple/gdata/老齢年金受給者.txt" For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3, a4
year = a1
age = a2
mjk(year, age) = a3
fjk(year, age) = a4
Loop
Close #2
Open "c:/simple/data/乗数.txt" For Input As #5
Do Until EOF(5)
Input #5, a1, a2
age = a1
jyo(age) = a2
Loop
Close #5
For age = 0 To 27
jyo(age) = jyo(27)
Next
For age = 47 To 199
jyo(age) = jyo(47)
Next
Open "c:/simple/gdata/マクロスライド.txt" For Input As #22
Do Until EOF(22)
Input #22, a1, a2
year = a1
macro(year) = a2
Loop
Close #22
Open "c:/simple/data/加給年金.txt" For Input As #33
Do Until EOF(33)
Input #33, a1, a2
age = a1
kaky(age) = a2
Loop
Close #33
Dim ystart As Single
Open "c:/simple/gdata/世代老齢年金受給額.txt" For Output As #44
For ystart = 0 To 199
Write #44, ystart, gen(ystart, mjk, fjk, mtime, ftime, jyo, macro, kaky)
Next
Close #44
For ystart = 1 To 199
Debug.Print gen(ystart, mjk, fjk, mtime, ftime, jyo, macro, kaky)
Next
End Sub
最終更新:2009年03月02日 00:36