02 厚生年金加入率 - プログラム倉庫

Function mr(n As Single, mp, m) As Single
Dim a1 As Single
Dim a2 As Single
a1 = 5 * (n - 1)
a2 = a1 + 4
If n = 4 Then a1 = 16
mc = 0
For age = a1 To a2
mc = mc + m(-3, age)
Next
mr = mp(n) / (10 * mc)
End Function
Function fr(year As Single, n As Single, fp, fk, f) As Single
Dim a1 As Single
Dim a2 As Single
Dim mr1 As Single
Dim mr2 As Single
Dim t1 As Single
a1 = 5 * (n - 1)
a2 = a1 + 4
If n = 4 Then a1 = 16
mc = 0
For age = a1 To a2
mc = mc + f(-3, age)
Next
mr1 = fp(n) / (10 * mc)
mc = 0
For age = a1 To a2
mc = mc + f(50, age)
Next
mr2 = fk(n) / (10 * mc)
t1 = year / 50
If t1 < 0 Then t1 = 0
If t1 > 1 Then t1 = 1
fr = mr1 + t1 * (mr2 - mr1)
End Function
Private Sub Command1_Click()
Dim n As Single
Dim year As Single
Dim age As Single
Dim mrate(-5 To 99, 16 To 65) As Single
Dim frate(-5 To 99, 16 To 65) As Single
Dim m(-5 To 99, 0 To 99) As Single
Dim f(-5 To 99, 0 To 99) As Single
Dim mp(4 To 13) As Single
Dim fp(4 To 13) As Single
Dim mk(4 To 13) As Single
Dim fk(4 To 13) As Single
mp(4) = 239
mp(5) = 2047
mp(6) = 3151
mp(7) = 2774
mp(8) = 2523
mp(9) = 2577
mp(10) = 3257
mp(11) = 2519
mp(12) = 2233
mp(13) = 1135
fp(4) = 188
fp(5) = 2016
fp(6) = 1849
fp(7) = 992
fp(8) = 875
fp(9) = 1033
fp(10) = 1511
fp(11) = 1138
fp(12) = 964
fp(13) = 438
mk(4) = 100
mk(5) = 900
mk(6) = 1600
mk(7) = 1800
mk(8) = 2000
mk(9) = 2200
mk(10) = 2100
mk(11) = 2000
mk(12) = 1800
mk(13) = 1100
fk(4) = 100
fk(5) = 900
fk(6) = 900
fk(7) = 800
fk(8) = 800
fk(9) = 900
fk(10) = 1000
fk(11) = 900
fk(12) = 900
fk(13) = 600
Open "c:/simple/gdata/将来推計人口.txt" For Input As #5
Do Until EOF(5)
Input #5, a1, a2, a3, a4
year = a1
age = a2
m(year, age) = a3
f(year, age) = a4
Loop
Close #5
For year = -3 To 99
For age = 16 To 64
n = Int(age / 5) + 1
mrate(year, age) = mr(n, mp, m)
frate(year, age) = fr(year, n, fp, fk, f)
Next
Next
Open "c:/simple/gdata/厚生年金加入率.txt" For Output As #1
For year = -3 To 99
For age = 16 To 64
Write #1, year, age, mrate(year, age), frate(year, age)
Next
Next
Close #1
End Sub