Option Explicit
Public Function fnWeekday(Serial As Date, Optional Switch As Byte = 0)
' #########################################################################
' #
' # 呼び出されると、引数の Serial から曜日/祝日情報を返すマクロ
' # デフォルトの戻り値は、以下の通り
' #
' # 戻り値の定義
' # 0 = 平日（月曜～金曜）
' # 1 = 日曜日(vbSunday)
' # 2 = 曜日月(vbMonday)
' # 3 = 火曜日(vbTuesday)
' # 4 = 水曜日(vbWednesday)
' # 5 = 木曜日(vbThursday)
' # 6 = 金曜日(vbFriday)
' # 7 = 土曜日(vbSaturday)
' # 8 = 祝日
' #
' #########################################################################
' ### 変数定義 #########################
Dim DEFpDayName As String
Dim DEFpDayMeaning As String
Dim pDayName As String
Dim pDayMeaning As String
Dim pRV As Byte
Dim pYYYY As Integer
Dim fSubstitute As Boolean
' ### 変数設定 #########################
DEFpDayName = "平日"
DEFpDayMeaning = "(Nothing)"
pDayName = DEFpDayName
pDayMeaning = DEFpDayMeaning
pYYYY = Year(Serial)
' ### メイン処理 #######################
' serial に指定された年月日と、該当する年の祝日に相当するシリアル値を比較する。
' 該当の祝日であれば、第2引数通りに変数を設定する。
' もし該当の祝日名があれば、戻り値 8 を指定する。
Select Case Serial
' 日付が固定されているもの
Case fnDate(pYYYY, 1, 1)
pDayName = "元旦"
pDayMeaning = "年のはじめを祝う。"
Case fnDate(pYYYY, 1, 15)
If pYYYY <= 1999 Then
pDayName = "成人の日"
pDayMeaning = "おとなになったことを自覚し、みずから生き抜こうとする青年を祝い、励ます。"
End If
Case fnDate(pYYYY, 2, 11)
pDayName = "建国記念の日"
pDayMeaning = "建国をしのび、国を愛する心を養う。"
Case fnDate(pYYYY, 2, 23)
If 2019 < pYYYY Then
pDayName = "天皇誕生日"
pDayMeaning = "天皇の誕生日を祝う。"
End If
Case fnDate(pYYYY, 4, 29)
If 2007 <= pYYYY Then
pDayName = "昭和の日"
pDayMeaning = "激動の日々を経て、復興を遂げた昭和の時代を顧み、国の将来に思いをいたす。"
ElseIf 1989 <= pYYYY Then
pDayName = "みどりの日"
pDayMeaning = "自然の恩恵に感謝する"
ElseIf 1948 <= pYYYY Then
pDayName = "天皇誕生日"
pDayMeaning = "天皇の誕生を祝う（昭和天皇）"
ElseIf 1927 <= pYYYY Then
pDayName = "天長節"
pDayMeaning = "天地が永久であるように天皇の治世も続くように"
End If
Case fnDate(pYYYY, 5, 3)
pDayName = "憲法記念日"
pDayMeaning = "日本国憲法の施行を記念し、国の成長を期する。"
Case fnDate(pYYYY, 5, 4)
If 2007 <= pYYYY Then
pDayName = "みどりの日"
pDayMeaning = "自然に親しむとともにその恩恵に感謝し、豊かな心をはぐくむ。"
End If
Case fnDate(pYYYY, 5, 5)
pDayName = "こどもの日"
pDayMeaning = "こどもの人格を重んじ、こどもの幸福をはかるとともに、母に感謝する。"
Case fnDate(pYYYY, 7, 20)
If pYYYY <= 2002 Then
pDayName = "海の日"
pDayMeaning = "海の恩恵に感謝するとともに、海洋国日本の繁栄を願う。"
End If
Case fnDate(pYYYY, 8, 11)
' 2014年制定、2016年より施工
If 2016 <= pYYYY Then
pDayName = "山の日"
pDayMeaning = "山に親しむ機会を得て、山の恩恵に感謝する。"
End If
Case fnDate(pYYYY, 9, 15)
If pYYYY <= 2002 Then
pDayName = "敬老の日"
pDayMeaning = "多年にわたり社会につくしてきた老人を敬愛し、長寿を祝う。"
End If
Case fnDate(pYYYY, 11, 3)
pDayName = "文化の日"
pDayMeaning = "自由と平和を愛し、文化をすすめる。"
Case fnDate(pYYYY, 11, 23)
pDayName = "勤労感謝の日"
pDayMeaning = "勤労をたっとび、生産を祝い、国民たがいに感謝しあう。"
Case fnDate(pYYYY, 12, 23)
If pYYYY < 2019 Then
' 以降、上皇陛下
pDayName = "天皇誕生日"
pDayMeaning = "天皇の誕生日を祝う。"
End If
End Select
Select Case Serial
' ハッピーマンデー
Case fnHappyMonday(pYYYY, 1, 2)
' 2000 年より適用
If 2000 <= pYYYY Then
pDayName = "成人の日"
pDayMeaning = "おとなになったことを自覚し、みずから生き抜こうとする青年を祝いはげます。"
End If
Case fnHappyMonday(pYYYY, 7, 3)
If 2003 <= pYYYY Then
' 2003 年より適用
pDayName = "海の日"
pDayMeaning = "海の恩恵に感謝するとともに、海洋国日本の繁栄を願う。"
End If
Case fnHappyMonday(pYYYY, 9, 3)
If 2003 <= pYYYY Then
pDayName = "敬老の日"
pDayMeaning = "多年にわたり社会につくしてきた老人を敬愛し、長寿を祝う。"
End If
Case fnHappyMonday(pYYYY, 10, 2)
' 2000 年より適用。2020 年より名称変更
If 2020 <= pYYYY Then
pDayName = "スポーツの日"
pDayMeaning = "スポーツを楽しみ、他者を尊重する精神を培うとともに、健康で活力ある社会の実現を願う。"
ElseIf 2000 <= pYYYY Then
pDayName = "体育の日"
pDayMeaning = "スポーツにしたしみ、健康な心身をつちかう日"
End If
' 春分/秋分の日
Case fnVernalEquinox(pYYYY)
pDayName = "春分の日"
pDayMeaning = "自然をたたえ、生物をいつくしむ。"
Case fnAutumnalEquinox(pYYYY)
pDayName = "秋分の日"
pDayMeaning = "祖先をうやまい、なくなった人々をしのぶ。"
End Select
' 天皇の即位の日及び即位礼正殿の儀の行われる日を休日とする法律
Select Case Serial
Case fnDate(2019, 5, 1)
pDayName = "天皇の即位の日"
Case fnDate(2019, 5, 2)
pDayName = "国民の休日"
Case fnDate(2019, 10, 22)
pDayName = "即位礼正殿の儀の行われる日"
End Select
' 振替休日
Select Case Serial
Case fnDate(pYYYY, 1, 1) + 1
If Weekday(Serial) = vbMonday Then fSubstitute = True
Case fnDate(pYYYY, 2, 11) + 1
If Weekday(Serial) = vbMonday Then fSubstitute = True
Case fnDate(pYYYY, 2, 23) + 1
If 2019 < pYYYY Then
If Weekday(Serial) = vbMonday Then fSubstitute = True
End If
Case fnDate(pYYYY, 4, 29) + 1
If Weekday(Serial) = vbMonday Then fSubstitute = True
Case fnDate(pYYYY, 5, 5) + 1
' 5月5日が日曜～火曜日だったら、5/6 が振替休日
If vbSunday <= Weekday(fnDate(pYYYY, 5, 5)) And Weekday(fnDate(pYYYY, 5, 5)) <= vbTuesday Then
fSubstitute = True
End If
Case fnDate(pYYYY, 8, 11) + 1
If Weekday(Serial) = vbMonday Then fSubstitute = True
Case fnDate(pYYYY, 11, 3) + 1
If Weekday(Serial) = vbMonday Then fSubstitute = True
Case fnDate(pYYYY, 11, 23) + 1
If Weekday(Serial) = vbMonday Then fSubstitute = True
Case fnDate(pYYYY, 12, 23) + 1
If pYYYY < 2019 Then
' 以降、上皇陛下
If Weekday(Serial) = vbMonday Then fSubstitute = True
End If
' ハッピーマンデー
Case fnHappyMonday(pYYYY, 1, 2) + 1
If Weekday(Serial) = vbMonday Then fSubstitute = True
Case fnHappyMonday(pYYYY, 7, 3) + 1
If Weekday(Serial) = vbMonday Then fSubstitute = True
Case fnHappyMonday(pYYYY, 9, 3) + 1
' シルバーウィーク対応
' もし、敬老の日の2日後が秋分の日なら、国民の休日にする。
If fnHappyMonday(pYYYY, 9, 3) + 2 = fnAutumnalEquinox(pYYYY) Then
pDayName = "国民の休日"
ElseIf Weekday(Serial) = vbMonday Then
fSubstitute = True
End If
Case fnHappyMonday(pYYYY, 10, 2) + 1
If Weekday(Serial) = vbMonday Then fSubstitute = True
' 春分/秋分の日
Case fnVernalEquinox(pYYYY) + 1
If Weekday(Serial) = vbMonday Then fSubstitute = True
Case fnAutumnalEquinox(pYYYY) + 1
If Weekday(Serial) = vbMonday Then fSubstitute = True
'Case DateValue("2020/9/22")
' DayName = "秋分の日"
End Select
If fSubstitute = True Then pDayName = "振替休日"
' -----------------------------------------------------------
' 令和 2 年(2020年)及び令和 3 年(2021年)に限り、
' 東京オリンピック・パラリンピック競技大会の開催にあわせ、
' 「海の日」、「スポーツの日」及び「山の日」が移動している。
' -----------------------------------------------------------
' 令和2年 (2020) & 令和3年 (2021)
Select Case Serial
' 海の日
Case fnHappyMonday(2020, 7, 3), fnHappyMonday(2021, 7, 3)
pDayName = DEFpDayName
pDayMeaning = DEFpDayMeaning
Case fnDate(2020, 7, 23)
pDayName = "海の日"
pDayMeaning = "海の恩恵に感謝するとともに、海洋国日本の繁栄を願う。"
Case fnDate(2021, 7, 22)
pDayName = "海の日"
pDayMeaning = "海の恩恵に感謝するとともに、海洋国日本の繁栄を願う。"
' スポーツの日
Case fnHappyMonday(2020, 10, 2), fnHappyMonday(2021, 10, 2)
pDayName = DEFpDayName
pDayMeaning = DEFpDayMeaning
Case fnDate(2020, 7, 24)
pDayName = "スポーツの日"
pDayMeaning = "スポーツを楽しみ、他者を尊重する精神を培うとともに、健康で活力ある社会の実現を願う。"
Case fnDate(2021, 7, 23)
pDayName = "スポーツの日"
pDayMeaning = "スポーツを楽しみ、他者を尊重する精神を培うとともに、健康で活力ある社会の実現を願う。"
' 山の日
Case fnDate(2020, 8, 11), fnDate(2021, 8, 11)
pDayName = DEFpDayName
pDayMeaning = DEFpDayMeaning
Case fnDate(2020, 8, 10)
pDayName = "山の日"
pDayMeaning = "山に親しむ機会を得て、山の恩恵に感謝する。"
Case fnDate(2021, 8, 8)
pDayName = "山の日"
pDayMeaning = "山に親しむ機会を得て、山の恩恵に感謝する。"
End Select
' 祝日値判定
If pDayName = DEFpDayName Then
' 平日/休日であれば、戻り値を 1～7 で指定する。
' ## 曜日選択 #####
If IsDate(Serial) Then
Select Case Weekday(Serial)
Case vbSunday
pRV = vbSunday
pDayName = "休日"
Case vbMonday
pRV = vbMonday
Case vbTuesday
pRV = vbTuesday
Case vbWednesday
pRV = vbWednesday
Case vbThursday
pRV = vbThursday
Case vbFriday
pRV = vbFriday
Case vbSaturday
pRV = vbSaturday
pDayName = "休日"
End Select
Else
' IsDate の判定内容にエラーがある場合
fnWeekday = "祝日値判定エラー"
Exit Function
End If
Else
' 平日でなければ、戻り値を 8 で指定する。
pRV = 8
End If
' ### 終了処理 #########################
' オプションの内容で、戻り値を変更する。
Select Case Switch
Case 0
fnWeekday = pRV
Case 1
fnWeekday = pDayName
Case 2
fnWeekday = pDayMeaning
End Select
' ######################################
End Function
Public Function fnDate(Year, Month, Day)
' #########################################################################
' #
' # VBA の date 関数は、Excel sheet の date 関数と異なり、文字列を指定する。
' # この関数は、セルで利用する date 関数と同じ使い勝手を実現するもの。
' #
' #########################################################################
fnDate = DateValue(Year & "/" & Month & "/" & Day)
End Function
Public Function fnHappyMonday(Year, Month, Weeks)
' #########################################################################
' #
' # ハッピーマンデー用のシリアル値を返す。
' # 指定された、Year 年 Month 月の第 Weeks 週の月曜日（シリアル値）を返す。
' #
' # 参考資料
' # http://www.relief.jp/itnote/archives/003241.php
' #########################################################################
Dim pMondayDate As Byte
Dim pFirstMonDay As Date
' ## 第1週目の月曜日を求める。
' 先に指定月の1日が何曜日なのかを見て、次の月曜日が何日なのかを指定する。
Select Case Weekday(fnDate(Year, Month, 1))
Case vbSunday ' 1
' ｘ月1日が日曜日なら、月曜日は翌日の 2 日
pMondayDate = 2
Case vbMonday ' 2
' ｘ月1日が月曜日なので、そのまま 1 日
pMondayDate = 1
Case vbTuesday ' 3
' ｘ月1日が火曜日なので、月曜日は 6 日後の 7 日
pMondayDate = 7
Case vbWednesday ' 4
' ｘ月1日が水曜日なので、月曜日は 5 日後の 6 日
pMondayDate = 6
Case vbThursday ' 5
pMondayDate = 5
Case vbFriday ' 6
pMondayDate = 4
Case vbSaturday ' 7
pMondayDate = 3
End Select
' 第1週目の月曜日から何週間後なのか、必要な日数を足してシリアル値を返す。
fnHappyMonday = fnDate(Year, Month, pMondayDate) + (7 * (Weeks - 1))
End Function
Public Function fnVernalEquinox(Year)
' #########################################################################
' #
' # 呼び出されると、引数の Year から算出した 春分の日 情報を返すマクロ
' #
' # 参考 URL http://www.wanichan.com/pc/excel/2010/5/page07.html
' #########################################################################
fnVernalEquinox = fnDate(Year, 3, Int(20.8431 + 0.242194 * (Year - 1980) - Int((Year - 1980) / 4)))
End Function
Public Function fnAutumnalEquinox(Year)
' #########################################################################
' #
' # 呼び出されると、引数の Year から算出した 秋分の日 情報を返すマクロ
' #
' # 参考 URL http://www.wanichan.com/pc/excel/2010/5/page07.html
' #########################################################################
fnAutumnalEquinox = fnDate(Year, 9, Int(23.2488 + 0.242194 * (Year - 1980) - Int((Year - 1980) / 4)))
End Function
