カレンダーを作成する場合などには 休日が必要になります
以前は日付が固定だったので比較的簡単に休日が設定できたのですが 最近は計算が必要な休日も増えました
春分の日や秋分の日は正式な日付は発表されないと定まりませんが 基本的には数式で算出することができます
休日や振替休日の設定は共通処理となるため関数化しています
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