HOME > 即効テクニック > Excel VBA > 日付・時刻関連のテクニック > 西暦年月日から和暦年を取得する

即効テクニック

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

西暦年月日から和暦年を取得する

(Excel 97/2000)
サンプルマクロは、インプットボックスに入力された西暦年月日から和暦年(享和以降)を取得し、メッセージボックスに表示します。
運用においては、各元号のデータはシート上あるいはマスタファイルで管理し、ループで読み込むのが実用的です。
Type pGengo
    pName As String
    pStart As Date
End Type

Sub Sample()

    Dim myGengo(14) As pGengo
    Dim i As Integer
    Dim strDate As String, myDate As Date
    Dim strYear As String

    With myGengo(0)
        .pName = "享和"
        .pStart = "1801/2/5"
    End With
    With myGengo(1)
        .pName = "文化"
        .pStart = "1804/2/11"
    End With
    With myGengo(2)
        .pName = "文政"
        .pStart = "1818/4/22"
    End With
    With myGengo(3)
        .pName = "天保"
        .pStart = "1830/12/10"
    End With
    With myGengo(4)
        .pName = "弘化"
        .pStart = "1844/12/2"
    End With
    With myGengo(5)
        .pName = "嘉永"
        .pStart = "1848/2/28"
    End With
    With myGengo(6)
        .pName = "安政"
        .pStart = "1854/11/27"
    End With
    With myGengo(7)
        .pName = "万延"
        .pStart = "1860/3/18"
    End With
    With myGengo(8)
        .pName = "文久"
        .pStart = "1861/2/19"
    End With
    With myGengo(9)
        .pName = "元治"
        .pStart = "1864/2/20"
    End With
    With myGengo(10)
        .pName = "慶応"
        .pStart = "1865/4/7"
    End With
    With myGengo(11)
        .pName = "明治"
        .pStart = "1868/9/8"
    End With
    With myGengo(12)
        .pName = "大正"
        .pStart = "1912/7/30"
    End With
    With myGengo(13)
        .pName = "昭和"
        .pStart = "1926/12/25"
    End With
    With myGengo(14)
        .pName = "平成"
        .pStart = "1989/1/8"
    End With

    On Error Resume Next
    Do
        strDate = InputBox("西暦年月日を入力してください。")
        If strDate = vbNullString Then Exit Sub
        myDate = CDate(strDate)
        If myDate < myGengo(i).pStart Then
            MsgBox "範囲外です。", vbCritical
        ElseIf Err.Number <> 0 Then
            MsgBox "入力エラーです。", vbCritical
            Err.Clear
        Else
            Exit Do
        End If
    Loop
    On Error GoTo 0
    
    For i = 0 To 13
        If myDate >= myGengo(i).pStart And _
            myDate < myGengo(i + 1).pStart Then Exit For
    Next
    
    strYear = Year(myDate) - Year(myGengo(i).pStart) + 1
    If strYear = "1" Then strYear = "元"
    strYear = myGengo(i).pName & strYear & "年"
    
    MsgBox strDate & "の元号は、『" & myGengo(i).pName & "』です。" _
        & vbCr & vbCr & "和暦表示では、『" & strYear & "』です。"

End Sub