Option Explicit

Public Function GetMonday(Gessho As Date, Shu As Integer) As Integer
'ユーザ関数　第○月曜日の計算
'入力（引数）：月初日(年月日)
'　　　　　　：何回目か
'出力(戻り値)：第○月曜日の日だけ  0:エラー、1〜31:正常値
    
    Dim Yobi_1      As Integer
    Dim FstMonday   As Integer
    Dim ChkMonday   As Integer

    GetMonday = 0     '戻り値の初期化
    
    '引数のチェック
    If Day(Gessho) <> 1 Then Exit Function
    If Shu < 1 Or 5 < Shu Then Exit Function
    
    Yobi_1 = YobiKeisan2(Gessho)        '一日(ついたち)の曜日を計算
    If Yobi_1 = 9 Then Exit Function    '戻り値のチェック
    
    FstMonday = (10 - Yobi_1) Mod 7      '第一月曜日の計算
    If FstMonday = 0 Then FstMonday = 7
    
    ChkMonday = FstMonday + (Shu - 1) * 7   '第○週目の月曜日の計算
    
    '計算後の日の妥当性チェック
    If IsDate(Format(Gessho, "yyyy/mm/") & ChkMonday) Then
        GetMonday = ChkMonday   '存在する日付なら戻り値をセットする
    End If

End Function

Public Function Shunbun(nen As Integer) As Integer
'ユーザ関数　春分の日の計算
'入力（引数）：年
'出力　　　　：春分の日の日だけ
    
    Dim Tsukabi     As Double
    Dim IdoRyo      As Double
    Dim ResetRyo    As Integer

    Shunbun = 0     '戻り値の初期化
    
    '引数のチェック
    If nen < 2000 Or 2099 < nen Then
        MsgBox "2000〜2099年ではありません。", , "春分の日の計算(Shunbun)"
        Exit Function
    End If
    
    Tsukabi = 20.69115                  '2000年の太陽の春分点通過日
    IdoRyo = (nen - 2000) * 0.242194    '春分点通過日の移動量
    ResetRyo = Int((nen - 2000) / 4)    '閏年によるリセット量
    Shunbun = Int(Tsukabi + IdoRyo - ResetRyo)  '春分の日の日だけ

End Function

Public Function Shunbun2(nen As Integer) As Integer
'ユーザ関数　春分の日の計算
'入力（引数）：年
'出力　　　　：春分の日の日だけ
    
    Dim Tsukabi     As Double
    Dim IdoRyo      As Double
    Dim ResetRyo    As Integer

    Shunbun2 = 0     '戻り値の初期化
    
    '引数のチェック
    If nen < 2000 Or 2099 < nen Then
        Exit Function
    End If
    
    Tsukabi = 20.69115                  '2000年の太陽の春分点通過日
    IdoRyo = (nen - 2000) * 0.242194    '春分点通過日の移動量
    ResetRyo = Int((nen - 2000) / 4)    '閏年によるリセット量
    Shunbun2 = Int(Tsukabi + IdoRyo - ResetRyo)  '春分の日の日だけ

End Function

Public Function Shubun(nen As Integer) As Integer
'ユーザ関数　秋分の日の計算
'入力（引数）：年
'出力　　　　：秋分の日の日だけ
    
    Dim Tsukabi     As Double
    Dim IdoRyo      As Double
    Dim ResetRyo    As Integer

    Shubun = 0     '戻り値の初期化
    
    '引数のチェック
    If nen < 2000 Or 2099 < nen Then
        MsgBox "2000〜2099年ではありません。", , "秋分の日の計算(Shubun)"
        Exit Function
    End If
    
    Tsukabi = 23.09                     '2000年の太陽の秋分点通過日
    IdoRyo = (nen - 2000) * 0.242194    '秋分点通過日の移動量
    ResetRyo = Int((nen - 2000) / 4)    '閏年によるリセット量
    Shubun = Int(Tsukabi + IdoRyo - ResetRyo)  '秋分の日の日だけ

End Function

Public Function Shubun2(nen As Integer) As Integer
'ユーザ関数　秋分の日の計算
'入力（引数）：年
'出力　　　　：秋分の日の日だけ
    
    Dim Tsukabi     As Double
    Dim IdoRyo      As Double
    Dim ResetRyo    As Integer

    Shubun2 = 0     '戻り値の初期化
    
    '引数のチェック
    If nen < 2000 Or 2099 < nen Then
        Exit Function
    End If
    
    Tsukabi = 23.09                     '2000年の太陽の秋分点通過日
    IdoRyo = (nen - 2000) * 0.242194    '秋分点通過日の移動量
    ResetRyo = Int((nen - 2000) / 4)    '閏年によるリセット量
    Shubun2 = Int(Tsukabi + IdoRyo - ResetRyo)  '秋分の日の日だけ

End Function

Public Function Uruu(nen As Integer) As Boolean

'ユーザ関数　閏年の判定
'入力（引数）：年
'出力　 True: 閏年　False:平年

    '引数のチェック
    If nen <= 1900 Or 2100 < nen Then
        MsgBox "20〜21世紀の年ではありません。", , "閏年の判定(Uruu)"
        Uruu = False    '戻り値のセット
        Exit Function
    End If

    If nen Mod 400 = 0 Then
        '400 で割り切れれば、閏年
        Uruu = True    '戻り値のセット
    Else
        If nen Mod 100 = 0 Then
            '100 で割り切れれば、平年
            Uruu = False    '戻り値のセット
        Else
            If nen Mod 4 = 0 Then
                '4 で割り切れれば、閏年
                Uruu = True    '戻り値のセット
            Else
                '上記以外は、平年
                Uruu = False    '戻り値のセット
            End If
        End If
    End If

End Function



Public Function YobiKeisan1(ymd As Date) As String
'ユーザ関数　曜日の計算
'入力（引数）：年月日
'出力　      : 曜日 (日,月,火,水,木,金,土)

    Dim Yobi(6) As String
    Dim nen     As Integer
    Dim tuki    As Integer
    Dim hi      As Integer
    Dim work    As Integer

    YobiKeisan1 = ""    '戻り値の初期化
    
    nen = Year(ymd)     '西暦年を求める
    tuki = Month(ymd)   '月を求める
    hi = Day(ymd)       '日を求める
    
    '引数のチェック
    If nen < 1900 Or 2099 < nen Then
        MsgBox "1900〜2099年ではありません。", , "曜日の計算(YobiKeisan1)"
        Exit Function
    End If

    Yobi(0) = "日"
    Yobi(1) = "月"
    Yobi(2) = "火"
    Yobi(3) = "水"
    Yobi(4) = "木"
    Yobi(5) = "金"
    Yobi(6) = "土"
    
    '手順1.：西暦年の下２桁に、
    '       その４分の１（端数切捨て）を足します。
    work = nen - 1900       '2000〜2099年対応
    work = work + work \ 4
    
    'うるう年の１月、２月の場合のみ、
    '1.の答えから1を引きます｡
    If Uruu(nen) Then       '閏年の判定
        If tuki = 1 Or tuki = 2 Then
            work = work - 1
        End If
    End If
    
    '手順2.：1.の答えに、求める月に応じて
    '       次の数を足します。
    Select Case tuki
      Case 5
        work = work + 1
      Case 8
        work = work + 2
      Case 2, 3, 11
        work = work + 3
      Case 6
        work = work + 4
      Case 9, 12
        work = work + 5
      Case 4, 7
        work = work + 6
    End Select
    
    '手順3.：2.の答えに，日の数を足します。
    work = work + hi
    
    '７で割った余りが０の時は日曜日、
    '１〜６の時は月〜土の各曜日に対応します。
    work = work Mod 7
    YobiKeisan1 = Yobi(work)

End Function

Public Function YobiKeisan2(ymd As Date) As Integer
'ユーザ関数　曜日の計算
'入力（引数）：年月日
'出力(戻り値)：曜日 (1〜7) 1:日曜〜7:土曜、9:エラー

    Dim nen     As Integer
    Dim tuki    As Integer
    Dim hi      As Integer
    Dim work    As Integer

    YobiKeisan2 = 9     '戻り値の初期化
    
    nen = Year(ymd)     '西暦年を求める
    tuki = Month(ymd)   '月を求める
    hi = Day(ymd)       '日を求める
    
    '引数のチェック
    If nen < 1900 Or 2099 < nen Then
        Exit Function
    End If
    
    '手順1.：西暦年の下２桁に、
    '       その４分の１（端数切捨て）を足します。
    work = nen - 1900       '2000〜2099年対応
    work = work + work \ 4
    
    'うるう年の１月、２月の場合のみ、
    '1.の答えから1を引きます｡
    If Uruu(nen) Then       '閏年の判定
        If tuki = 1 Or tuki = 2 Then
            work = work - 1
        End If
    End If
    
    '手順2.：1.の答えに、求める月に応じて
    '       次の数を足します。
    Select Case tuki
      Case 5
        work = work + 1
      Case 8
        work = work + 2
      Case 2, 3, 11
        work = work + 3
      Case 6
        work = work + 4
      Case 9, 12
        work = work + 5
      Case 4, 7
        work = work + 6
    End Select
    
    '手順3.：2.の答えに，日の数を足します。
    work = work + hi
    
    '７で割った余りが０の時は日曜日、
    '１〜６の時は月〜土の各曜日に対応します。
    work = work Mod 7
    YobiKeisan2 = work + 1  '関数 Weekday の戻り値に合わせる

End Function