休日を配列に格納する

カレンダーを作成する場合などには 休日が必要になります
以前は日付が固定だったので比較的簡単に休日が設定できたのですが 最近は計算が必要な休日も増えました

春分の日や秋分の日は正式な日付は発表されないと定まりませんが 基本的には数式で算出することができます

休日や振替休日の設定は共通処理となるため関数化しています

Dim l_year As Long
Dim l_day As Long
Dim l_day2 As Long
Dim l_weekday As Long
Dim d_date() As Date
Dim st_name() As String

l_year = 2009
ReDim d_date(0)

Call SetHoliday(d_date, st_name, DateSerial(l_year, 1, 1), "元旦", False)
If (l_year >= 2000) Then
    l_day = 14 - (Weekday(CDate(l_year & "/01/01")) + 4) Mod 7
Else
    l_day = 15
End If
Call SetHoliday(d_date, st_name, DateSerial(l_year, 1, l_day), "成人の日", True)

Call SetHoliday(d_date, st_name, DateSerial(l_year, 2, 11), "建国記念の日", True)

Select Case l_year
    Case Is < 1980
        l_day = Int(20.8357 + (0.242194 * (l_year - 1980)) - Int((l_year - 1980) / 4))
    Case Is < 2100
        l_day = Int(20.8431 + (0.242194 * (l_year - 1980)) - Int((l_year - 1980) / 4))
    Case Else
        l_day = Int(21.851 + (0.242194 * (l_year - 1980)) - Int((l_year - 1980) / 4))
End Select
Call SetHoliday(d_date, st_name, DateSerial(l_year, 3, l_day), "春分の日", True)

If (l_year >= 2007) Then
    Call SetHoliday(d_date, st_name, DateSerial(l_year, 4, 29), "昭和の日", True)
Else
    Call SetHoliday(d_date, st_name, DateSerial(l_year, 4, 29), "みどりの日", True)
End If

Select Case l_year
    Case Is < 1985
        Call SetHoliday(d_date, st_name, DateSerial(l_year, 5, 3), "憲法記念日", True)
        Call SetHoliday(d_date, st_name, DateSerial(l_year, 5, 5), "こどもの日", True)
    Case Is < 2007
        Call SetHoliday(d_date, st_name, DateSerial(l_year, 5, 3), "憲法記念日", False)
        Call SetHoliday(d_date, st_name, DateSerial(l_year, 5, 4), "国民の休日", False)
        Call SetHoliday(d_date, st_name, DateSerial(l_year, 5, 5), "こどもの日", True)
    Case Else
        Call SetHoliday(d_date, st_name, DateSerial(l_year, 5, 3), "憲法記念日", False)
        Call SetHoliday(d_date, st_name, DateSerial(l_year, 5, 4), "みどりの休日", False)
        Call SetHoliday(d_date, st_name, DateSerial(l_year, 5, 5), "こどもの日", True)
        If (Weekday(DateSerial(l_year, 5, 6)) = vbTuesday Or _
            Weekday(DateSerial(l_year, 5, 6)) = vbWednesday) Then
            Call SetHoliday(d_date, st_name, DateSerial(l_year, 5, 6), "振替休日", False)
        End If
End Select

If (l_year >= 1996) Then
    If (l_year >= 2003) Then
        l_day = 21 - (Weekday(CDate(l_year & "/07/01")) + 4) Mod 7
    Else
        l_day = 20
    End If
    Call SetHoliday(d_date, st_name, DateSerial(l_year, 7, l_day), "海の日", True)
End If

If (l_year >= 2003) Then
    l_day = 21 - (Weekday(CDate(l_year & "/09/01")) + 4) Mod 7
Else
    l_day = 15
End If
Call SetHoliday(d_date, st_name, DateSerial(l_year, 9, l_day), "敬老の日", True)
Select Case l_year
    Case Is < 1980
        l_day2 = Int(23.2588 + (0.242194 * (l_year - 1980)) - Int((l_year - 1980) / 4))
    Case Is < 2100
        l_day2 = Int(23.2488 + (0.242194 * (l_year - 1980)) - Int((l_year - 1980) / 4))
    Case Else
        l_day2 = Int(24.2488 + (0.242194 * (l_year - 1980)) - Int((l_year - 1980) / 4))
End Select
If (l_year >= 2003 And (l_day + 2) = l_day2) Then
    Call SetHoliday(d_date, st_name, DateSerial(l_year, 9, l_day + 1), "国民の休日", True)
End If
Call SetHoliday(d_date, st_name, DateSerial(l_year, 9, l_day2), "秋分の日", True)

If (l_year >= 2000) Then
    l_day = 14 - (Weekday(CDate(l_year & "/10/01")) + 4) Mod 7
Else
    l_day = 10
End If
Call SetHoliday(d_date, st_name, DateSerial(l_year, 10, l_day), "体育の日", True)

Call SetHoliday(d_date, st_name, DateSerial(l_year, 11, 3), "文化の日", True)
Call SetHoliday(d_date, st_name, DateSerial(l_year, 11, 23), "勤労感謝の日", True)

If (l_year >= 1989) Then
    Call SetHoliday(d_date, st_name, DateSerial(l_year, 12, 23), "天皇誕生日", True)
End If


Sub SetHoliday(d_date() As Date, st_name() As String, _
               ByVal d_holiday As Date, ByVal st_holidayname As String, _
               ByVal bln_holiday As Boolean)

    Dim l_idx As Long

    l_idx = UBound(d_date) + 1
    ReDim Preserve d_date(l_idx)
    ReDim Preserve st_name(l_idx)
    d_date(l_idx) = d_holiday
    st_name(l_idx) = st_holidayname

    If (bln_holiday) Then
        If (Weekday(d_holiday) = vbSunday) Then
            l_idx = UBound(d_date) + 1
            ReDim Preserve d_date(l_idx)
            ReDim Preserve st_name(l_idx)
            d_date(l_idx) = DateAdd("d", 1, d_holiday)
            st_name(l_idx) = "振替休日"
        End If
    End If

End Sub