ｇｈｊｊ - プログラム倉庫

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
Function makebaby(year As Single, f, birth) As Single
Dim age As Single
Dim baby As Single
baby = 0
For age = 15 To 49
baby = baby + birth(year, age) * f(year, age)
Next
makebaby = baby
End Function
Function makem(year As Single, age As Single, m, mde) As Single
makem = (1 - mde(year - 1, age - 1)) * m(year - 1, age - 1)
End Function
Function makef(year As Single, age As Single, f, fde) As Single
makef = (1 - fde(year - 1, age - 1)) * f(year - 1, age - 1)
End Function
Private Sub Command1_Click()
Dim m(5 To 99, 0 To 99) As Single
Dim f(5 To 99, 0 To 99) As Single
Dim startm(0 To 99) As Single
Dim startf(0 To 99) As Single
Dim mde(5 To 99, 0 To 99) As Single
Dim fde(5 To 99, 0 To 99) As Single
Dim birth(5 To 99, 15 To 49) As Single
Dim year As Single
Dim age As Single
Dim baby As Single
Dim a1 As Single
Dim a2 As Single
Dim a3 As Single
Dim a4 As Single
Open "c:/hagetaka/gdata/国勢調査.txt" For Input As #101
Do Until EOF(101)
Input #101, a1, a2, a3
age = a1
startm(age) = a2
startf(age) = a3
Loop
Close #101
Open "c:/hagetaka/gdata/出生率.txt" For Input As #102
Do Until EOF(102)
Input #102, a1, a2, a3
year = a1
age = a2
birth(year, age) = a3
Loop
Close #102
Open "c:/hagetaka/gdata/生命表.txt" For Input As #103
Do Until EOF(103)
Input #103, a1, a2, a3, a4
year = a1
age = a2
mde(year, age) = a3
fde(year, age) = a4
Loop
Close #103
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) = makem(year, age, m, mde)
f(year, age) = makef(year, age, f, fde)
Next
ch = makebaby(year, f, birth)
m(year, 0) = 1.05 * ch / 2.05
f(year, 0) = ch / 2.05
Next
Open "c:/hagetaka/gdata/将来推計人口.txt" For Output As #104
For year = 5 To 99
For age = 0 To 99
Write #104, year, age, m(year, age), f(year, age)
Next
Next
Close #104
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