サンプルマクロは、インプットボックスに入力された西暦年月日から
和暦年(享和以降)を取得し、メッセージボックスに表示します。
運用においては、各元号のデータはシート上あるいはマスタファイルで管理し、
ループで読み込むのが実用的です。
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
|