Excel VBA で休日祝日判定(再掲)
Excel VBA で祝日判定(再掲)
再掲
ずいぶん前に記載していた、専用シートを使わない Excel VBA での祝日判定。
Excel で休日祝日判定 - KuroNeko666’s blog
2020年は、いろいろ特殊っぽいのがいまさらわかったので、改造ついでに再掲します。
つぎのソースをコピペして使ってください。
ソース
Option Explicit Public Function chkHoliday(Serial, Optional RVFlag As Byte = 0) ' ######################################################################### ' # 呼び出されると、引数のSerialから休日/祝日判定フラグを返すマクロ ' ######################################################################### ' 戻り値の定義 ' 0 = 平日 ' 1 = 日曜日(vbSunday) ' 7 = 土曜日(vbSaturday) ' 8 = 祝日 ' 変数の宣言 Dim RV As Byte Dim DayName As String Dim YYYY As Integer Dim fSubstitute As Boolean ' 振替休日フラグ ' ### メイン ############################################################## DayName = "平日" YYYY = Year(Serial) ' ## 祝日判定 ##### '元日 1月1日 '成人の日 1月の第2月曜日 '建国記念の日 政令で定める日(2/11) '春分の日 春分の日 '昭和の日 4月29日 '憲法記念日 5月3日 'みどりの日 5月4日 'こどもの日 5月5日 '海の日 7月の第3月曜日 '山の日 8月11日 '敬老の日 9月の第3月曜日 '秋分の日 秋分の日 '体育の日 10月の第2月曜日 (2020年からスポーツの日に名称変更) '文化の日 11月3日 '勤労感謝の日 11月23日 '天皇誕生日 12月23日 → 2月23日(2019年 天皇の即位に伴う変更) '国民の休日 祝日に挟まれた平日 '天皇の即位の日及び即位礼正殿の儀の行われる日を休日とする法律 2019年5月1日と2019年10月22日 ' 規定の日付 Select Case Serial Case DateValue(YYYY & "/1/1") DayName = "元旦" Case DateValue(YYYY & "/1/2") DayName = "年始" Case DateValue(YYYY & "/1/3") DayName = "年始" Case NumWeek(YYYY, 1, 2) DayName = "成人の日" Case DateValue(YYYY & "/2/11") DayName = "建国記念の日" Case DateValue(YYYY & "/2/23") If 2019 < YYYY Then DayName = "天皇誕生日" End If Case DateValue(YYYY & "/3/" & Int(20.8431 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) ' 参考URL http://www.wanichan.com/pc/excel/2010/5/page07.html DayName = "春分の日" Case DateValue(YYYY & "/4/29") DayName = "昭和の日" Case DateValue("2019/4/30") DayName = "国民の休日" Case DateValue("2019/5/1") DayName = "天皇の即位の日" Case DateValue("2019/5/2") DayName = "国民の休日" Case DateValue(YYYY & "/5/3") DayName = "憲法記念日" Case DateValue(YYYY & "/5/4") DayName = "みどりの日" Case DateValue(YYYY & "/5/5") DayName = "こどもの日" Case NumWeek(YYYY, 7, 3) DayName = "海の日" Case DateValue(YYYY & "/8/11") DayName = "山の日" Case NumWeek(YYYY, 9, 3) DayName = "敬老の日" Case NumWeek(YYYY, 9, 3) + 1 If DateValue(YYYY & "/9/" & Int(23.2488 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) = NumWeek(YYYY, 9, 3) + 2 Then DayName = "国民の休日" End If Case DateValue(YYYY & "/9/" & Int(23.2488 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) ' 参考URL http://www.wanichan.com/pc/excel/2010/5/page07.html DayName = "秋分の日" Case NumWeek(YYYY, 10, 2) If YYYY <= 2019 Then DayName = "体育の日" Else DayName = "スポーツの日" End If Case DateValue("2019/10/22") DayName = "即位礼正殿の儀の行われる日" Case DateValue(YYYY & "/11/3") DayName = "文化の日" Case DateValue(YYYY & "/11/23") DayName = "勤労感謝の日" Case DateValue(YYYY & "/12/23") If YYYY < 2019 Then DayName = "天皇誕生日" End If Case DateValue(YYYY & "/12/31") DayName = "年末" End Select ' 振替休日 ' 「国民の祝日」が日曜日に当たるときは、その日後においてその日に最も近い「国民の祝日」でない日を休日とする ' なので「国民の祝日」の翌日が月曜日だったときも、振替休日となる Select Case Serial Case DateValue(YYYY & "/1/1") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/2/11") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/2/23") + 1 If YYYY > 2019 And Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/3/" & Int(20.8431 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/4/29") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/5/5") + 1 ' 5月5日が日曜~火曜日だったら、振替休日確定 If vbSunday <= Weekday(DateValue(YYYY & "/5/5")) And Weekday(DateValue(YYYY & "/5/5")) <= vbTuesday Then fSubstitute = True Case DateValue(YYYY & "/9/" & Int(23.2488 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/11/3") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/11/23") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/12/23") + 1 If YYYY < 2019 And Weekday(Serial) = vbMonday Then fSubstitute = True End Select If fSubstitute = True Then DayName = "振替休日" End If ' 2020年特殊対応 Select Case Serial Case DateValue("2020/7/20") DayName = "平日" Case NumWeek(2020, 10, 2) DayName = "平日" Case DateValue("2020/8/11") DayName = "平日" Case DateValue("2020/7/23") DayName = "海の日" Case DateValue("2020/7/24") DayName = "スポーツの日" Case DateValue("2020/8/10") DayName = "山の日" Case DateValue("2020/9/22") DayName = "秋分の日" End Select ' 祝日値判定 If DayName = "平日" Then ' ## 曜日選択 ##### If IsDate(Serial) Then Select Case Weekday(Serial) Case vbSunday RV = vbSunday 'Case vbMonday ' RV = vbMonday 'Case vbTuesday ' RV = vbTuesday 'Case vbWednesday ' RV = vbWednesday 'Case vbThursday ' RV = vbThursday 'Case vbFriday ' RV = vbFriday Case vbSaturday RV = vbSaturday End Select 'RV = Weekday(Serial) Else Exit Function End If Else RV = 8 End If ' ### 終了処理 ############################################################ Select Case RVFlag Case 0 chkHoliday = RV Case 1 chkHoliday = DayName End Select End Function Public Function NumWeek(Year, Month, Weeks) ' 参考資料 ' http://www.relief.jp/itnote/archives/003241.php Dim MonNum As Byte Dim FirstMonDay As Date ' 第1週目の月曜日を求める Select Case Weekday(DateValue(Year & "/" & Month & "/1")) Case vbSunday ' 1 MonNum = 1 Case vbMonday ' 2 MonNum = 0 Case vbTuesday ' 3 MonNum = 6 Case vbWednesday ' 4 MonNum = 5 Case vbThursday ' 5 MonNum = 4 Case vbFriday ' 6 MonNum = 3 Case vbSaturday ' 7 MonNum = 2 End Select FirstMonDay = DateValue(Year & "/" & Month & "/" & 1 + MonNum) ' 第1週目月曜日から何週間後なのか、シリアル値を出力 NumWeek = DateValue(Year & "/" & Month & "/" & 1 + MonNum) + 7 * (Weeks - 1) End Function