26 遺族年金受給者 - プログラム倉庫

Function si(year As Integer, mi, fi) As Single
Dim s1 As Single
s1 = 0
For age = 16 To 99
s1 = s1 + mi(year, age) + fi(year, age)
Next
si = s1
End Function
Private Sub Command1_Click()
Dim year As Integer
Dim age As Integer
Dim m2(-5 To 99, 16 To 65) As Single
Dim f2(-5 To 99, 16 To 65) As Single
Dim mjk(-5 To 99, 0 To 99) As Single
Dim fjk(-5 To 99, 0 To 99) As Single
Dim mi(-5 To 99, 0 To 99) As Single
Dim fi(-5 To 99, 0 To 99) As Single
Dim ide(1 To 2, 0 To 110) As Single
Dim de(1 To 2, 0 To 110) As Single
Dim beta(1 To 2, 15 To 65) As Single
Dim mfu(1 To 2, 15 To 110) As Single
Dim ffu(1 To 2, 15 To 110) As Single
Dim nen(1 To 2, 15 To 110) As Integer
Dim a1 As Single
Dim a2 As Single
Dim a3 As Single
Dim a4 As Single
Dim a5 As Single
Dim a6 As Single
Dim a7 As Single
Dim a8 As Single
Dim a9 As Single
Open "c:/simple/gdata/厚生年金被保険者.txt" For Input As #1
Do Until EOF(1)
Input #1, a1, a2, a3, a4
year = a1
age = a2
m2(year, age) = a3
f2(year, age) = a4
Loop
Close #1
Open "c:/simple/data/失権率.txt" For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3, a4, a5, a6, a7
age = a1
de(1, age) = a2
de(2, age) = a5
ide(1, age) = a4
ide(2, age) = a7
Loop
Close #2
Open "c:/simple/data/脱退率.txt" For Input As #3
Do Until EOF(3)
Input #3, a1, a2, a3, a4, a5, a6, a7, a8, a9
age = a1
beta(1, age) = a4
beta(2, age) = a8
Loop
Close #3
Open "c:/simple/data/有遺族.txt" For Input As #4
Do Until EOF(4)
Input #4, a1, a2, a3, a4, a5, a6, a7
age = a1
mfu(1, age) = a2
mfu(2, age) = a3
ffu(1, age) = a5
ffu(2, age) = a6
Loop
Close #4
Open "c:/simple/gdata/老齢年金受給者.txt" For Input As #6
Do Until EOF(6)
Input #6, a1, a2, a3, a4
year = a1
age = a2
mjk(year, age) = a3
fjk(year, age) = a4
Loop
Close #6
Dim mc(1 To 20, 1 To 9) As Single
Dim fc(1 To 20, 1 To 9) As Single
Open "c:/simple/data/男子受給者.txt" For Input As #7
n = 1
s = 1
Do Until EOF(7)
Input #7, a1
mc(n, s) = a1 / 10
s = s + 1
If s = 10 Then n = n + 1
If s = 10 Then s = 1
Loop
Close #7
Open "c:/simple/data/女子受給者.txt" For Input As #8
n = 1
s = 1
Do Until EOF(8)
Input #8, a1
fc(n, s) = a1 / 10
s = s + 1
If s = 10 Then n = n + 1
If s = 10 Then s = 1
Loop
Close #8

year = -3
For age = 0 To 99
n = Int(age / 5) + 1
mi(year, age) = mc(n, 7) / 5
fi(year, age) = fc(n, 7) / 5
Next
Dim newm(-5 To 99, 0 To 110) As Single
Dim newf(-5 To 99, 0 To 110) As Single
Dim am(-5 To 99, 16 To 99) As Single
Dim af(-5 To 99, 16 To 99) As Single
Dim bm(-5 To 99, 1 To 99) As Single
Dim bf(-5 To 99, 1 To 99) As Single
For year = -3 To 99
For age = 16 To 65
am(year, age) = mfu(1, age) * beta(1, age) * m2(year, age)
af(year, age) = ffu(1, age) * beta(2, age) * f2(year, age)
Next
Next
For year = -2 To 99
For age = 40 To 99
bm(year, age) = mfu(2, age) * de(1, age) * mjk(year, age)
bf(year, age) = ffu(2, age) * de(2, age) * fjk(year, age)
Next
Next
Dim n1 As Integer
Dim n2 As Integer
For year = -2 To 99
For age = 16 To 99
newf(year, age) = af(year, age) + bf(year, age)
newm(year, age) = am(year, age) + bm(year, age)
Next
Next
For year = -2 To 99
For age = 16 To 99
mi(year, age) = (1 - ide(1, age - 1)) * mi(year - 1, age - 1) + newm(year, age)
fi(year, age) = (1 - ide(2, age - 1)) * fi(year - 1, age - 1) + newf(year, age)
Next
Next
Open "c:/simple/gdata/遺族年金受給者.txt" For Output As #10
For year = -5 To 99
For age = 20 To 99
Write #10, year, age, mi(year, age), fi(year, age)
Next
Next
Close #10
For n = 1 To 5
year = 5 * n
Debug.Print year, Int(si(year, mi, fi))
Next
For n = 3 To 6
year = 10 * n
Debug.Print year, Int(si(year, mi, fi))
Next
z1 = 0
For age = 16 To 99
z1 = z1 + newm(0, age) + newf(0, age)
Next
End Sub