にっきダイアリー

はてなダイアリーからはてなblogに移動してみました。

VBAで計算する春分の日と秋分の日

Wikipedia春分の日秋分の日のページにあった簡易計算をそのままVBAにしただけ。

' 春分の日 (1900-2099)
Function Speq(Optional year As Integer = 0) As Integer
    Dim my As Integer
    
    ' 年の指定がないときは今年で計算
    If y = 0 Then
        y = Int(Format(Date, "yyyy"))
    End If
    
    my = y Mod 4
    Speq = 20

    Select Case my
        Case 0 '西暦年数の4での剰余が0の場合
            Select Case y
                Case Is <= 1956 '1900年 - 1956年までは3月21日
                    Speq = 21
                Case 1960 To 2088 '1960年 - 2088年までは3月20日
                    Speq = 20
                Case Is >= 2092 '2092年 - 2096年までは3月19日
                    Speq = 19
            End Select
        
        Case 1 '西暦年数の4での剰余が1の場合
            Select Case y
                Case Is <= 1989 '1901年 - 1989年までは3月21日
                    Speq = 21
                Case Is >= 1993 '1993年 - 2097年までは3月20日
                    Speq = 20
            End Select

        Case 2 '西暦年数の4での剰余が2の場合
            Select Case y
                Case Is <= 2022 '1902年 - 2022年までは3月21日
                    Speq = 21
                Case Is >= 2026 '2026年 - 2098年までは3月20日
                    Speq = 20
            End Select
        
        Case 3 '西暦年数の4での剰余が3の場合
            Select Case y
                Case Is <= 1923 '1903年 - 1923年までは3月22日
                    Speq = 22
                Case 1927 To 2055 '1927年 - 2055年までは3月21日
                    Speq = 21
                Case Is >= 2059 '2059年 - 2099年までは3月20日
                    Speq = 20
            End Select
    End Select
    
End Function

' 秋分の日 (1900-2099)
Function Aueq(Optional y As Integer = 0) As Integer
    Dim my As Integer
    
    ' 年の指定がないときは今年で計算
    If y = 0 Then
        y = Int(Format(Date, "yyyy"))
    End If
    
    my = y Mod 4
    Aueq = 23

    Select Case my
        Case 0 '西暦年数の4での剰余が0の場合
            Select Case y
                Case Is <= 2008 '1900年〜2008年までは9月23日
                    Aueq = 23
                Case Is >= 2012 '2012年〜2096年までは9月22日
                    Aueq = 22
            End Select
        
        Case 1 '西暦年数の4での剰余が1の場合
            Select Case y
                Case Is <= 1917 '1901年〜1917年までは9月24日
                    Aueq = 24
                Case 1921 To 2041 '1921年〜2041年までは9月23日
                    Aueq = 23
                Case Is >= 2045 '2045年〜2097年までは9月22日
                    Aueq = 22
            End Select

        Case 2 '西暦年数の4での剰余が2の場合
            Select Case y
                Case Is <= 1946 '1902年〜1946年までは9月24日
                    Aueq = 24
                Case 1950 To 2074 '1950年〜2074年までは9月23日
                    Aueq = 23
                Case Is >= 2078 '2078年〜2098年までは9月22日
                    Aueq = 22
            End Select

        Case 3 '西暦年数の4での剰余が3の場合
            Select Case y
                Case Is <= 1979 '1903年〜1979年までは9月24日
                    Aueq = 24
                Case Is >= 1083 '1983年〜2099年までは9月23日
                    Aueq = 23
            End Select
            
    End Select
    
End Function
  • 2015/03/31 秋分の日のcase3 の数値が間違ってたので修正(コメントはあってるのにねえ……