２３ DIG - プログラム倉庫

Private Sub Command1_Click()
Dim byear As Single
Dim age As Single
Dim car As Single
Dim mis(1900 To 2100, 14 To 69, 1 To 49) As Single
Dim mos(1900 To 2100, 14 To 69, 1 To 49) As Single
Dim m2by(1900 To 2100, 15 To 69) As Single
Dim f2by(1900 To 2100, 15 To 69) As Single
Dim mdeby(1900 To 2100, 0 To 99) As Single
Dim fdeby(1900 To 2100, 0 To 99) As Single
Dim alpha(15 To 69) As Single
Dim beta(15 To 69) As Single
Dim gamma(15 To 69) As Single
Dim theta(15 To 65) As Single
Dim zan(1900 To 2100, 15 To 64, 1 To 49) As Single
Dim zant(1900 To 2100, 15 To 64, 1 To 49) As Single
Dim mde(1900 To 2100, 0 To 99) As Single
Dim minx(14 To 75, 0 To 50) As Single
Dim mout(14 To 75, 0 To 50) As Single
Dim mnew(1900 To 2100) As Single
Dim mtime(1900 To 2100) As Single
Dim ftime(1900 To 2100) As Single
Dim z1 As Single
Dim z2 As Single
Dim z3 As Single
Dim v As Single
Open "c:/dig/data/男子脱退力.txt " For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3, a4
age = a1
gamma(age) = a2
alpha(age) = a3
beta(age) = a4
Loop
Close #2
Open "c:/dig/data/再加入率.txt " For Input As #3
Do Until EOF(3)
Input #3, a1, a2, a3, a4
age = a1
theta(age) = a2
Loop
Close #3
Open "c:/dig/gdata/男子被保険者.txt " For Input As #6
Do Until EOF(6)
Input #6, a1, a2, a3
age = a1
car = a2
minx(age, car) = a3
Loop
Close #6
Open "c:/dig/gdata/男子待期者.txt " For Input As #7
Do Until EOF(7)
Input #7, a1, a2, a3
age = a1
car = a2
mout(age, car) = a3
Loop
Close #7
Open "c:/dig/gdata/変形厚生年金被保険者.txt " For Input As #5
Do Until EOF(5)
Input #5, a1, a2, a3, a4
byear = a1
age = a2
m2by(byear, age) = a3
f2by(byear, age) = a4
Loop
Close #5
Open "c:/dig/data/報酬裁定.txt " For Input As #15
Do Until EOF(15)
Input #15, a1, a2, a3
byear = a1
mtime(byear) = a2
ftime(byear) = a3
Loop
Close #15
For byear = 1940 To 1950
mtime(byear) = 60
ftime(byear) = 60
Next
For byear = 1970 To 1989
mtime(byear) = 65
ftime(byear) = 65
Next
For byear = 1949 To 1989
ageage = 2008 - byear
age = ageage
For car = 1 To 49
a1 = minx(age, car)
a2 = mout(age, car)
mis(byear, age, car) = a1
mos(byear, age, car) = a2
Next
age = ageage + 1
mis(byear, age, 1) = m2by(byear, age)
endtime = mtime(byear)
For age = ageage + 1 To endtime
z1 = (1 - gamma(age - 1)) * m2by(byear, age - 1)
z2 = m2by(byear, age) - z1
If z2 < 0 Then z2 = 0
z3 = (1 - theta(age)) * z2
z4 = theta(age) * z2
mis(byear, age, 1) = z3
z5 = 0
For car = 1 To 49
z5 = z5 + mos(byear, age - 1, car)
Next
If z5 = 0 Then z5 = 1
v = z4 / z5
If v > 1 Then v = 1
For car = 2 To 49
mis(byear, age, car) = (1 - gamma(age - 1)) * mis(byear, age - 1, car - 1) + v * mos(byear, age - 1, car - 1)
Next
For car = 1 To 49
mos(byear, age, car) = (gamma(age - 1) - alpha(age - 1) - beta(age)) * mis(byear, age - 1, car) + (1 - alpha(age - 1) - v) * mos(byear, age - 1, car)
Next
Next
age = endtime
z1 = 0
For car = 25 To 49
z1 = z1 + mis(byear, age, car) + mos(byear, age, car)
Next
mnew(byear) = z1
Debug.Print byear, mnew(byear)
Next
Open "c:/dig/gdata/男子新規裁定者2.txt " For Output As #4
For byear = 1949 To 1989
Write #4, byear, mnew(byear)
Next
Close #4
End Sub