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