０１０１ - プログラム倉庫

Private Sub Command1_Click()
Dim a1 As Single
Dim a2 As Single
Dim a3 As Single
Dim a(0 To 100) As Single
Dim b(0 To 1000) As Single
Dim c(1 To 11, 15 To 49) As Single
Dim md(0 To 120, 1 To 11) As Single
Dim fd(0 To 120, 1 To 11) As Single
Dim mde(0 To 99, 0 To 120) As Single
Dim fde(0 To 99, 0 To 120) As Single
Dim m(0 To 99, 0 To 99) As Single
Dim f(0 To 99, 0 To 99) As Single
Dim mx(0 To 100, 0 To 100) As Single
Dim fx(0 To 100, 0 To 100) As Single
Dim startm(0 To 100) As Single
Dim startf(0 To 100) As Single
Dim n As Single
Dim year As Single
Dim age As Single
Dim ch As Single
n = 0
Open "c:/nagoya/data/国勢調査.txt" For Input As #1
Do Until EOF(1)
Input #1, a1, a2
a(n) = a1
b(n) = a2
n = n + 1
Loop
Close #1
For age = 0 To 100
startm(age) = a(age) / 10 ^ 4
startf(age) = b(age) / 10 ^ 4
Next
Open "c:/nagoya/data/出生率1.txt " For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3, a4, a5, a6, a7
age = a1
c(1, age) = a2
c(2, age) = a3
c(3, age) = a4
c(4, age) = a5
c(5, age) = a6
c(6, age) = a7
Loop
Close #2
Open "c:/nagoya/data/出生率2.txt " For Input As #3
Do Until EOF(3)
Input #3, a1, a2, a3, a4, a5, a6
age = a1
c(7, age) = a2
c(8, age) = a3
c(9, age) = a4
c(10, age) = a5
c(11, age) = a6
Loop
Close #3

Open "c:/nagoya/data/男性生命表.txt " For Input As #4
Do Until EOF(4)
Input #4, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12
age = a1
md(age, 1) = a2
md(age, 2) = a3
md(age, 3) = a4
md(age, 4) = a5
md(age, 5) = a6
md(age, 6) = a7
md(age, 7) = a8
md(age, 8) = a9
md(age, 9) = a10
md(age, 10) = a11
md(age, 11) = a12
Loop
Close #4
Open "c:/nagoya/data/女性生命表.txt " For Input As #5
Do Until EOF(5)
Input #5, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12
age = a1
fd(age, 1) = a2
fd(age, 2) = a3
fd(age, 3) = a4
fd(age, 4) = a5
fd(age, 5) = a6
fd(age, 6) = a7
fd(age, 7) = a8
fd(age, 8) = a9
fd(age, 9) = a10
fd(age, 10) = a11
fd(age, 11) = a12
Loop
Close #5
Open "c:/nagoya/data/将来推計人口.txt" For Input As #55
Do Until EOF(55)
Input #55, a1, a2, a3, a4
year = a1
age = a2
mx(year, age) = a3 / 10
fx(year, age) = a4 / 10
Loop
Close #55

For year = 5 To 99
For age = 0 To 99
n1 = year / 5
n2 = Int(n1)
If n2 > 11 Then n2 = 11
n3 = n2 + 1
If n3 > 11 Then n3 = 11
mde(year, age) = md(age, n2) + (n1 - n2) * (md(age, n3) - md(age, n2))
fde(year, age) = fd(age, n2) + (n1 - n2) * (fd(age, n3) - fd(age, n2))
Next
Next
Dim birth(0 To 99, 15 To 49) As Single
For year = 5 To 99
For age = 15 To 49
n1 = year / 5
n2 = Int(n1)
If n2 > 11 Then n2 = 11
n3 = n2 + 1
If n3 > 11 Then n3 = 11
birth(year, age) = c(n2, age) + (n1 - n2) * (c(n3, age) - c(n2, age))
Next
Next

For age = 0 To 99
m(5, age) = startm(age)
f(5, age) = startf(age)
Next
For year = 6 To 99
For age = 1 To 99
m(year, age) = (1 - mde(year - 1, age - 1)) * m(year - 1, age - 1)
f(year, age) = (1 - fde(year - 1, age - 1)) * f(year - 1, age - 1)
If year = 10 Then m(year, age) = mx(year, age)
If year = 10 Then f(year, age) = fx(year, age)
If year = 20 Then m(year, age) = mx(year, age)
If year = 20 Then f(year, age) = fx(year, age)
If year = 30 Then m(year, age) = mx(year, age)
If year = 30 Then f(year, age) = fx(year, age)
If year = 40 Then m(year, age) = mx(year, age)
If year = 40 Then f(year, age) = fx(year, age)
If year = 50 Then m(year, age) = mx(year, age)
If year = 50 Then f(year, age) = fx(year, age)
If year = 60 Then m(year, age) = mx(year, age)
If year = 60 Then f(year, age) = fx(year, age)
If year = 70 Then m(year, age) = mx(year, age)
If year = 70 Then f(year, age) = fx(year, age)
If year = 80 Then m(year, age) = mx(year, age)
If year = 80 Then f(year, age) = fx(year, age)
If year = 90 Then m(year, age) = mx(year, age)
If year = 90 Then f(year, age) = fx(year, age)
Next
ch = 0
For age = 15 To 49
ch = ch + birth(year, age) * f(year, age)
Next
Debug.Print year, ch
m(year, 0) = 1.05 * ch / 2.05
f(year, 0) = ch / 2.05
Next
Open "c:/nagoya/gdata/将来推計人口.txt" For Output As #11
For year = 0 To 99
For age = 0 To 99
Write #11, year, age, m(year, age), f(year, age)
Next
Next
Close #11
For year = 5 To 99
p1 = 0
For age = 0 To 99
p1 = p1 + m(year, age) + f(year, age)
Next
Debug.Print year, p1
Next

End Sub