新元号に対応する関数

新元号に対応する関数

 

Option Explicit

 

Function 元号(ByVal 日 As String) As String '新元号に対応するユーザー定義関数

  

Dim 新元号 As String
Dim 日付 As Date

 

新元号 = "令和" '　　　　　　　　　                                         新元号を入力

If IsNumeric(Left$(日, 1)) Then
        日付 = CDate(日)

        If 日付 < 43586 Then '                                              2019/4/30以前
                元号 = Format(日付, "ggge年m月d日")
            ElseIf 日付 > 43830 Then '                                      2020/1/1以降
                元号 = Format(日付, 新元号 & Year(日付) - 2018 & "年m月d日")
            Else
                元号 = Format(日付, 新元号 & "元年m月d日") '                元年表記
        End If
    Else
        If Left$(日, 2) = 新元号 Then
                If Mid$(日, 3, 1) = "元" Then
                        元号 = Format(CDate("2019" & Right$(日, Len(日) - InStr(日, "年") + 1)), "yyyy年m月d日")
                    Else
                        元号 = Format(CDate(CStr(2018 + Val(Mid$(日, 3, InStr(日, "年") - 3))) & Right$(日, Len(日) - InStr(日, "年") + 1)), "yyyy年m月d日")
                End If
            Else
                元号 = Format(CDate(日), "yyyy年m月d日")
        End If
End If
 

End Function

 

以上。