０１ 将来推計人口（ストリーム） - プログラム倉庫

Function pop(year As Single, m, f) As Single
Dim p1 As Single
p1 = 0
For age = 0 To 99
p1 = p1 + m(year, age) + f(year, age)
Next
pop = Int(p1)
End Function
Private Sub Command1_Click()
Dim m(0 To 99, 0 To 99) As Single
Dim f(0 To 99, 0 To 99) As Single
Dim mde(0 To 99, 0 To 99) As Single
Dim fde(0 To 99, 0 To 99) As Single
Dim birth(0 To 99, 15 To 49) As Single
Dim year As Single
Dim age As Single
Dim z1 As Single
Dim a1 As Single
Dim a2 As Single
Open "c:/stream/data/国勢調査.txt" For Input As #12
Do Until EOF(12)
Input #12, a1, a2, a3
age = a1
m(0, age) = a2
f(0, age) = a3
Loop
Close #12
Open "c:/stream/data/男子生命表.txt" For Input As #1
Do Until EOF(1)
Input #1, a1, a2, a3
year = a1
age = a2
mde(year, age) = a3
Loop
Close #1
Open "c:/stream/data/女子生命表.txt" For Input As #3
Do Until EOF(3)
Input #3, a1, a2, a3
year = a1
age = a2
fde(year, age) = a3
Loop
Close #3
Open "c:/stream/data/出生率.txt" For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3
year = a1
age = a2
birth(year, age) = a3
Loop
Close #2
For year = 1 To 99
z1 = 0
For age = 15 To 49
z1 = z1 + birth(year - 1, age) * f(year - 1, age)
Next
m(year, 0) = 1.05 * z1 / 2.05
f(year, 0) = z1 / 2.05
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)
Next
Next
Open "c:/stream/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 n = 1 To 5
year = 5 * n
Debug.Print year, pop(year, m, f)
Next
For n = 3 To 5
year = 10 * n
Debug.Print year, pop(year, m, f)
Next
End Sub