HOME > 即効テクニック > Excel VBA > 日付・時刻関連のテクニック > 生年月日から簡易履歴を作成する

即効テクニック

日付・時刻関連のテクニック

生年月日から簡易履歴を作成する

(Excel 97/2000)
サンプルマクロは、インプットボックスに入力された生年月日から簡易履歴を作成し、新規シートに出力します。
Sub Sample()

    Dim myTitle As Variant
    Dim strBirth As String, dateBirth As Date
    Dim myDate As Date

    myTitle = Array("小学校卒業", "中学校卒業" _
        , "高校入学", "高校卒業", "大学入学" _
        , "大学卒業", "(短大卒業)")

    On Error Resume Next
    Do
        strBirth = InputBox("誕生日を入力してください。")
        If strBirth = vbNullString Then Exit Sub
        Err.Clear
        dateBirth = CDate(strBirth)
    Loop Until Err.Number = 0
    On Error GoTo 0
    
    myDate = dateBirth
    Do Until Month(myDate) = 4 And Day(myDate) = 1
        myDate = DateAdd("d", 1, myDate)
    Loop
    
    Application.ScreenUpdating = False
    
    Sheets.Add , Sheets(Sheets.Count)
    Range("A1:G1").Value = myTitle
    Columns("A:G").AutoFit
    With Range("A2")
        .Value = Year(myDate) + 12 & "/3"
        .Offset(, 1).Value = Year(myDate) + 15 & "/3"
        .Offset(, 2).Value = Year(myDate) + 15 & "/4"
        .Offset(, 3).Value = Year(myDate) + 18 & "/3"
        .Offset(, 4).Value = Year(myDate) + 18 & "/4"
        .Offset(, 5).Value = Year(myDate) + 22 & "/3"
        .Offset(, 6).Value = Year(myDate) + 20 & "/3"
    End With
    
    Application.ScreenUpdating = True

End Sub