Function makemde(year As Single, age As Single, data04) As Single
Dim n1 As Single
Dim n2 As Single
Dim n3 As Single
n1 = year / 5
n2 = Int(n1)
If n2 > 11 Then n2 = 11
n3 = n2 + 1
If n3 > 11 Then n3 = 11
makemde = data04(age, n2) + (n1 - n2) * (data04(age, n3) - data04(age, n2))
End Function
Function makefde(year As Single, age As Single, data05) As Single
Dim n1 As Single
Dim n2 As Single
Dim n3 As Single
n1 = year / 5
n2 = Int(n1)
If n2 > 11 Then n2 = 11
n3 = n2 + 1
If n3 > 11 Then n3 = 11
makefde = data05(age, n2) + (n1 - n2) * (data05(age, n3) - data05(age, n2))
End Function
Private Sub Command1_Click()
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
Dim a10 As Single
Dim a11 As Single
Dim a12 As Single
Dim year As Single
Dim age As Single
Dim data04(0 To 130, 1 To 11) As Single
Dim data05(0 To 130, 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
Open "c:/hagetaka/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
data04(age, 1) = a2
data04(age, 2) = a3
data04(age, 3) = a4
data04(age, 4) = a5
data04(age, 5) = a6
data04(age, 6) = a7
data04(age, 7) = a8
data04(age, 8) = a9
data04(age, 9) = a10
data04(age, 10) = a11
data04(age, 11) = a12
Loop
Close #4
Open "c:/hagetaka/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
data05(age, 1) = a2
data05(age, 2) = a3
data05(age, 3) = a4
data05(age, 4) = a5
data05(age, 5) = a6
data05(age, 6) = a7
data05(age, 7) = a8
data05(age, 8) = a9
data05(age, 9) = a10
data05(age, 10) = a11
data05(age, 11) = a12
Loop
Close #5
For year = 5 To 99
For age = 0 To 99
mde(year, age) = makemde(year, age, data04)
fde(year, age) = makefde(year, age, data05)
Next
Next
Open "c:/hagetaka/gdata/生命表.txt" For Output As #103
For year = 5 To 99
For age = 15 To 49
Write #103, year, age, mde(year, age), fde(year, age)
Next
Next
Close #103
End Sub
最終更新:2010年03月13日 01:07