VBA で作った休日クラス

COPY

Option Explicit
'-----------------------------------

Private Enum YobiType
    Shuku = 10
    Kokumin = 11
    Hurikae = 12
    Kanrei = 13
End Enum

Private memShukuzitu        As Dictionary
Private memKokumin          As Dictionary
Private memHurikae          As Dictionary
Private memKanrei           As Dictionary
Private memYear             As Long
Private memMonth            As Long
Private memDay              As Long
Private memFormat           As String
'-----------------------------------
'
Public Property Let NowYear(Val As Long)
    Call KyuzituSet(Val)
End Property
'-----------------------------------
'
Public Property Get NowYear() As Long
    NowYear = memYear
End Property
'-----------------------------------
'
Public Property Let SetStrDate(Val As String)

    If IsDate(Val) Then
        Call KyuzituSet(CLng(DatePart("yyyy", Val)))
        memMonth = CLng(DatePart("m", Val))
        memDay = CLng(DatePart("d", Val))
    Else
        Call KyuzituSet(1900)
        memMonth = 1
        memDay = 1
    End If

End Property
'-----------------------------------
'
Public Property Let SetNumDate(Val As Long)

    Call KyuzituSet(Year(Val))
    memMonth = Month(Val)
    memDay = Day(Val)

End Property
'-----------------------------------
'
Public Property Let FormatFormat(Val As String)
    memFormat = Val
End Property
'-----------------------------------
'
Public Property Get GetStrDate() As String
    GetStrDate = Format(DateSerial(memYear, memMonth, memDay), memFormat)
End Property
'-----------------------------------
'
Public Property Get WeekNum() As Long
    WeekNum = Yobi
End Property
'-----------------------------------
'
Public Property Get DateNum() As Long
    DateNum = DateSerial(memYear, memMonth, memDay)
End Property
'-----------------------------------
'
Private Sub Class_Initialize()

    Call KyuzituSet(Year(Date))
    memMonth = Month(Date)
    memDay = Day(Date)

End Sub
'-----------------------------------
'
Private Sub Class_Terminate()

    Set memShukuzitu = Nothing
    Set memKokumin = Nothing
    Set memHurikae = Nothing
    Set memKanrei = Nothing

End Sub
'-----------------------------------
'
Private Function Yobi() As Long

    If memShukuzitu.Exists(DateNum) Then
        Yobi = YobiType.Shuku
        Exit Function
    End If

    If memKokumin.Exists(DateNum) Then
        Yobi = YobiType.Kokumin
        Exit Function
    End If

    If memHurikae.Exists(DateNum) Then
        Yobi = YobiType.Kanrei
        Exit Function
    End If

    If memKanrei.Exists(DateNum) Then
        Yobi = YobiType.Kanrei
        Exit Function
    End If

    Yobi = Weekday(DateNum, vbSunday)

End Function
'-----------------------------------
'
Private Sub KyuzituSet(NewYear As Long)

    If memYear <> NewYear Then
        memYear = NewYear
        Call makeShukuzitu
        Call makeKokumin
        Call makeHurikae
        Call makeKanrei
    End If

End Sub
'-----------------------------------
'ロング値で与えられた日付の休日判定を行ないます。
Private Sub makeShukuzitu()
    Dim iDay                As Long

    Set memShukuzitu = Nothing
    Set memShukuzitu = New Dictionary

    '----------元日
    If DateSerial(memYear, 1, 1) > DateSerial(1948, 7, 19) Then
        memShukuzitu.Add DateSerial(memYear, 1, 1), "元旦"
    End If
    
    '----------成人の日　１月１５日　→　１月の第２月曜
    If memYear > 1949 And memYear < 2000 Then
        memShukuzitu.Add DateSerial(memYear, 1, 15), "成人の日"
    ElseIf memYear > 1999 Then
        memShukuzitu.Add DateSerial(memYear, 1, 14) - (Weekday(DateSerial(memYear, 1, 14), vbTuesday) Mod 7), "成人の日"
    End If
        
    '----------建国記念の日
    If DateSerial(memYear, 2, 11) > DateSerial(1948, 7, 19) Then
        memShukuzitu.Add DateSerial(memYear, 2, 11), "建国記念の日"
    End If

    '----------天皇誕生日
    If memYear > 2019 Then
        memShukuzitu.Add DateSerial(memYear, 2, 23), "天皇誕生日"
    End If

    '----------春分の日
    'int(19.8277+0.242194*(年-1980)-int((年-1983)/4))   ----------1851-1899年通用
    'int(20.8357+0.242194*(年-1980)-int((年-1983)/4))   ----------1900-1979年通用
    'int(20.8431+0.242194*(年-1980)-int((年-1980)/4))   ----------1980-2099年通用
    'int(21.8510+0.242194*(年-1980)-int((年-1980)/4))   ----------2100-2150年通用
    Select Case memYear
    Case Is < 2100
        iDay = Int(20.8431 + 0.242194 * (memYear - 1980) - Int((memYear - 1980) / 4))
    Case Is >= 2100
        iDay = Int(20.851 + 0.242194 * (memYear - 1980) - Int((memYear - 1980) / 4))
    End Select
    If DateSerial(memYear, 3, iDay) > DateSerial(1948, 7, 19) Then
        memShukuzitu.Add DateSerial(memYear, 3, iDay), "春分の日"
    End If
            
    '----------天皇誕生日→みどりの日→昭和の日
    If DateSerial(memYear, 4, 29) > DateSerial(1948, 7, 19) Then
        memShukuzitu.Add DateSerial(memYear, 4, 29), "昭和の日"
    End If

    '----------即位の礼
    If memYear = 2019 Then
        memShukuzitu.Add DateSerial(memYear, 5, 1), "即位の礼"
    End If

    '----------憲法記念日
    If DateSerial(memYear, 5, 3) > DateSerial(1948, 7, 19) Then
        memShukuzitu.Add DateSerial(memYear, 5, 3), "憲法記念日"
    End If

    '----------みどりの日
    If memYear > 2006 Then
        memShukuzitu.Add DateSerial(memYear, 5, 4), "みどりの日"
    End If
        
    '----------こどもの日
    If DateSerial(memYear, 5, 5) > DateSerial(1948, 7, 19) Then
        memShukuzitu.Add DateSerial(memYear, 5, 5), "こどもの日"
    End If

    '----------海の日　７月２０日　→　７月の第３月曜日
    If memYear > 1995 And memYear < 2003 Then
        memShukuzitu.Add DateSerial(memYear, 7, 20), "海の日"
    ElseIf memYear > 2002 Then
        If memYear = 2020 Then
            'オリンピックイヤー
            memShukuzitu.Add DateSerial(memYear, 7, 23), "海の日"
        ElseIf memYear = 2021 Then
            'オリンピックイヤー
            memShukuzitu.Add DateSerial(memYear, 7, 22), "海の日"
        Else
            memShukuzitu.Add DateSerial(memYear, 7, 21) - (Weekday(DateSerial(memYear, 7, 21), vbTuesday) Mod 7), "海の日"
        End If
    End If

    '----------山の日"
    If memYear > 2015 Then
        If memYear = 2020 Then
            'オリンピックイヤー
            memShukuzitu.Add DateSerial(memYear, 8, 10), "山の日"
        ElseIf memYear = 2021 Then
            'オリンピックイヤー
            memShukuzitu.Add DateSerial(memYear, 8, 8), "山の日"
        Else
            memShukuzitu.Add DateSerial(memYear, 8, 11), "山の日"
        End If
    End If
     
    '----------敬老の日　９月１５日　→　９月の第３月曜日
    If memYear > 1965 And memYear < 2003 Then
        memShukuzitu.Add DateSerial(memYear, 9, 15), "敬老の日"
    ElseIf memYear > 2002 Then
        memShukuzitu.Add DateSerial(memYear, 9, 21) - (Weekday(DateSerial(memYear, 9, 21), vbTuesday) Mod 7), "敬老の日"
    End If
            
    '----------秋分の日
    'int(22.2588+0.242194*(年-1980)-int((年-1983)/4))   ----------1851-1899年通用
    'int(23.2588+0.242194*(年-1980)-int((年-1983)/4))   ----------1900-1979年通用
    'int(23.2488+0.242194*(年-1980)-int((年-1980)/4))   ----------1980-2099年通用
    'int(24.2488+0.242194*(年-1980)-int((年-1980)/4))   ----------2100-2150年通用
    Select Case memYear
    Case Is < 2100
        iDay = Int(23.2488 + 0.242194 * (memYear - 1980) - Int((memYear - 1980) / 4))
    Case Is >= 2100
        iDay = Int(24.2488 + 0.242194 * (memYear - 1980) - Int((memYear - 1980) / 4))
    End Select
    If DateSerial(memYear, 9, iDay) > DateSerial(1948, 7, 19) Then
        memShukuzitu.Add DateSerial(memYear, 9, iDay), "秋分の日"
    End If
   
    '----------体育の日 →　スポーツの日　１０月１０日　→　１０月の第二月曜日
    If memYear > 1965 And memYear < 2000 Then
        memShukuzitu.Add DateSerial(memYear, 10, 10), "体育の日"
    ElseIf memYear > 1999 Then
        If memYear = 2020 Then
            'オリンピックイヤー
            memShukuzitu.Add DateSerial(memYear, 7, 24), "スポーツの日"
        ElseIf memYear = 2021 Then
            'オリンピックイヤー
            memShukuzitu.Add DateSerial(memYear, 7, 23), "スポーツの日"
        Else
            memShukuzitu.Add DateSerial(memYear, 10, 14) - (Weekday(DateSerial(memYear, 10, 14), vbTuesday) Mod 7), "スポーツの日"
        End If
    End If

    '----------即位礼正殿の儀
    If memYear = 2019 Then
        memShukuzitu.Add DateSerial(memYear, 10, 22), "即位礼正殿の儀"
    End If

    '----------文化の日
    If DateSerial(memYear, 11, 3) > DateSerial(1948, 7, 19) Then
        memShukuzitu.Add DateSerial(memYear, 11, 3), "文化の日"
    End If

    '----------勤労感謝の日
    If DateSerial(memYear, 11, 23) > DateSerial(1948, 7, 19) Then
        memShukuzitu.Add DateSerial(memYear, 11, 23), "勤労感謝の日"
    End If

    '----------天皇誕生日
    If memYear > 1988 And memYear < 2019 Then
        memShukuzitu.Add DateSerial(memYear, 12, 23), "天皇誕生日"
    End If

End Sub
'-----------------------------------
'
Private Sub makeKokumin()
    Dim D()                 As Long
    Dim Keys                As Variant
    Dim iCount              As Long
    Dim I                   As Long
    Dim J                   As Long
    Dim Target              As Long

    Set memKokumin = Nothing
    Set memKokumin = New Dictionary

    If memShukuzitu.Count = 0 Then
        Exit Sub
    End If

    If memYear < 1988 Then
        Exit Sub
    End If

    '-------------------------------国民の休日の判定
    ReDim D(memShukuzitu.Count - 1)
    For Each Keys In memShukuzitu
        D(iCount) = Keys
        iCount = iCount + 1
    Next

    For I = 0 To UBound(D)
        For J = 0 To UBound(D)
            '-----------------------該当の組み合わせがある場合
            If D(J) - D(I) = 2 Then
                Target = (D(J) + D(I)) / 2
                If Not memShukuzitu.Exists(Target) Then
                    memKokumin.Add Target, "休日"
                End If
            End If
        Next J
    Next I

End Sub
'-----------------------------------
'
Private Sub makeHurikae()
    Dim iDay                As Long
    Dim fDay                As Long
    Dim boHurikae           As Boolean

    Set memHurikae = Nothing
    Set memHurikae = New Dictionary

    If memShukuzitu.Count = 0 Then
        Exit Sub
    End If

    If memYear < 1973 Then
        Exit Sub
    End If

    For iDay = DateSerial(memYear, 1, 1) To DateSerial(memYear, 12, 31)
        '---------------------------日曜日であること
        If Weekday(iDay) = 1 Then
            '-------------------祝日であること
            If memShukuzitu.Exists(iDay) Then
                boHurikae = True
                fDay = iDay
            End If
        End If

        '---------------------------フラッグを立てた後、最初の祝日でない日を振替日とする
        If boHurikae = True Then
            If iDay > fDay Then
                '-------------------祝休日に該当しない場合、振替日にする
                If Not memShukuzitu.Exists(iDay) Then
                    memHurikae.Add iDay, "振替"
                    boHurikae = False
                End If
            End If
        End If

    Next iDay

End Sub
'-----------------------------------
'
Private Sub makeKanrei()

    Set memKanrei = Nothing
    Set memKanrei = New Dictionary

    '-----------------------------------慣例になっている休日
    With memKanrei
        .Add DateSerial(memYear, 1, 1), "慣例"
        .Add DateSerial(memYear, 1, 2), "慣例"
        .Add DateSerial(memYear, 1, 3), "慣例"
        .Add DateSerial(memYear, 12, 31), "慣例"
    End With

End Sub