カレンダー計算（2）MJDから日付への変換

修正ユリウス日から日付へ変換する

MJDからグレゴリオ暦とユリウス暦の日付へ変換するプログラム。

'MJDから日付へ変換する

Dim mjd '修正ユリウス日(MJD)
Dim msg '表示するメッセージ
Dim cal

Set cal = New C_Calender

mjd = 60676 'デフォルト値として2025/1/1のMJD

Do
    mjd = InputBox("MJDを入力してください。", ,mjd)
    If mjd = "" Then Exit Do 'キャンセルが押された場合は終了
    mjd = CDbl(mjd) '文字列から数値に変換

    msg = "MJD=" & mjd & vbCr & vbCr
    msg = msg & "グレゴリオ暦" & vbCr
    cal.Mode = 1
    msg = msg & cal.Execute(mjd) & vbCr & vbCr
    msg = msg & "ユリウス暦" & vbCr
    cal.Mode = 2
    msg = msg & cal.Execute(mjd) & vbCr
    Msgbox msg,, "修正ユリウス日"
Loop


Class C_Calender
    Private m_type
    Private zeroDay 'それぞれの暦における紀元前1年2月29日のMJD
    Private arrYears
    Private arrDays


    Private Sub Class_Initialize()
        arrYears = Array(0,  1,   4,  100,   400)
    End Sub


    Public Property Let Mode(val)
        m_type = val

        If val = 1 Then 'グレゴリオ暦の場合
            zeroDay = -678882
            arrDays  = Array(1,365,1461,36524,146097)

        ElseIf val = 2 Then 'ユリウス暦の場合
            zeroDay = -678884
            arrDays  = Array(1,365,1461)
        
        End If
    End Property


    Public Function Execute(mjd)
    'MJDに対応する日付を返す
        Dim y, m, d, a

        'MJDをそれぞれの暦の西暦0年(紀元前1年)2月29日を第0日とした日数へ変換
        d = mjd - zeroDay
        y = 0
        m = 3

        '年の計算
        a = Div(d, arrDays)
        y = y + Mul(a, arrYears)
        d = a(0)

        '月の計算
        If d < 1 Then 'dは小数点以下で時刻を表していることに注意
        '2月末日の場合
            m = 2 '2月
            If LeapYear(a) Then
                d = 29 + d
            Else
                d = 28 + d
            End If
        Else '2月末日以外の場合
            Do While MonthDay(m) < d
                m = m + 1
            Loop
            d = d - MonthDay(m - 1)
            If m > 12 Then
                y = y + 1
                m = m - 12
            End If
        End If
        Execute =  Join(Array(y,m,Round(d, 5)), "/") '日は小数点以下5桁まで
    End Function


    Private Function LeapYear(a)
    'うるう年ならTrue、そうでなければFalseを返す
    'aは配列
        LeapYear = False

        'グレゴリオ暦の場合
        If m_type = 1 Then
            If a(1) = 0 And (a(2) <> 0 Or a(3) = 0) Then
                LeapYear = True
            End If
        End If

        'ユリウス暦の場合
        If m_type = 2 Then
            If a(1) = 0 Then
                LeapYear = True
            End If
        End If
    End Function


    Function MonthDay(M)
    '2月末日を第0日としてM月末日までの日数を返す(M=2～13)
        MonthDay = Int(30.59 * (M - 1)) - 30
    End Function

End Class


Function Div(val, arr)
'例えばarr=[1,365,1461]の場合、a(0)+365*a(1)+1461*a(2)=valとなる配列aを返す
    Dim i, iMax
    Dim a '戻り値となる配列

    iMax = UBound(arr)
    ReDim a(iMax)
    a(0) = val
    For i = iMax To 1 Step -1
        a(i) = Int(a(0) / arr(i))   '商の整数部
        a(0) = a(0) - arr(i) * a(i) '余り(>0)
    Next
    Div = a
End Function


Function Mul(arr1, arr2)
'2つの配列の「内積」を返す
    Dim i, iMax
    Dim a '戻り値となる配列

    If UBound(arr1) < UBound(arr2) Then
        iMax = UBound(arr1)
    Else
        iMax = UBound(arr2)
    End If

    For i = 0 To iMax
        a = a + arr1(i) * arr2(i)
    Next
    Mul = a
End Function

実行例

ダブルクリックしてMJDを入力すると、ダイアログボックスが表示される。以下は60676と入力した場合の表示例。

MJD=60676

グレゴリオ暦
2025/1/1

ユリウス暦
2024/12/19

もしユリウス暦を現代まで使い続けていたら、実際の季節の移り変わりに対し13日ほど暦が遅れていた。例えば冬至が1月4日頃になっていた。