Private Sub Command1_Click()
Dim a1 As Single
Dim a2 As Single
Dim b1(0 To 120) As Single
Dim b2(0 To 120) As Single
Dim b3(0 To 120) As Single
Dim b4(0 To 120) As Single
Dim c1(0 To 120) As Single
Dim c2(0 To 120) As Single
Dim c3(0 To 120) As Single
Dim c4(0 To 120) As Single
Dim mj(0 To 99, 0 To 99) As Single
Dim fj(0 To 99, 0 To 99) As Single
Dim mnew(1900 To 2100) As Single
Dim fnew(1900 To 2100) As Single
Dim mde(0 To 130) As Single
Dim fde(0 To 130) As Single
Dim age As Single
Dim year As Single
Dim byear As Single
Dim n As Single
n = 1
Open "c:/eli/data/男子受給者.txt " For Input As #1
Do Until EOF(1)
Input #1, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14
age = a1
b1(age) = a4
b2(age) = a5
b3(age) = a8
b4(age) = a9
Loop
Close #1
n = 1
Open "c:/eli/data/女子受給者.txt " For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14
age = a1
c1(age) = a4
c2(age) = a5
c3(age) = a8
c4(age) = a9
Loop
Close #2
Open "c:/eli/data/男子失権率.txt " For Input As #3
Do Until EOF(3)
Input #3, a1, a2, a3, a4
age = a1
mde(age) = a2
Loop
Close #3
Open "c:/eli/data/女子失権率.txt " For Input As #4
Do Until EOF(4)
Input #4, a1, a2, a3, a4
age = a1
fde(age) = a2
Loop
Close #4
Open "c:/eli/gdata/通算年金新規裁定者.txt " For Input As #5
Do Until EOF(5)
Input #5, a1, a2, a3
byear = a1
mnew(byear) = a2
fnew(byear) = a3
Loop
Close #5
For age = 1 To 99
mj(8, age) = (b1(age) + b2(age) + b3(age) + b4(age)) / 10 ^ 4
fj(8, age) = (c1(age) + c2(age) + c3(age) + c4(age)) / 10 ^ 4
Next
For year = 9 To 99
byear = year + 2000 - 65
For age = 1 To 99
mj(year, age) = (1 - mde(age - 1)) * mj(year - 1, age - 1)
fj(year, age) = (1 - fde(age - 1)) * fj(year - 1, age - 1)
Next
mj(year, 65) = mj(year, 65) + mnew(byear)
fj(year, 65) = fj(year, 65) + fnew(byear)
Next
Open "c:/eli/gdata/通算年金.txt " For Output As #6
For year = 10 To 99
For age = 0 To 99
Write #6, year, age, mj(year, age), fj(year, age)
Next
Next
Close #6
For year = 10 To 99
a1 = 0
For age = 0 To 99
a1 = a1 + mj(year, age) + fj(year, age)
Next
Debug.Print year, a1
Next
End Sub
最終更新:2010年03月30日 21:28