Excel Access VBA 成人の日、体育の日、敬老の日、第5週の月曜日を計算するユーザー定義関数

これはシートで計算する場合はこちら

【Excel Tips】成人の日や体育の日などのハッピーマンデーの日付を求めるには？ 2008/11/27 09:00

成人の日（1月の第2月曜日）を求める−WEEKDAY関数・DATE関数 -relief

古くからある手法ですが、だれも計算しないですよね。
年間カレンダーの作成

3つのポイント

シート上ではDate関数,VBAではDateSerial関数は日付を0にすると前月末の日付になる。

これを利用して前月末が何日かを気にせず日付を取得して曜日を取得します

第1が7第2が14第三が21第4が28。

VBAでは35から引くと第5週がわかります

ネットでは1999年以前が存在しない

いつからかは忘れたけど、とりあえず1999年以前はちゃんと日付だそうよ
ただ振替休日には対応していません。また、何年前かまでは調べていないので、あまり過去にさかのぼらないでください。

コード(2020独裁シフト対応済)

4桁の西暦で日付を返します
上から
体育の日
成人の日
敬老の日
です。

Function DayOfJpnGymnasticDay(iyear) As Date
'体育の日を返します
'なお2021年からはスポーツの日になります
'日本政府を止めない限り2020年は7月24日に移動します
If clng(iyear) >= 2000 And iyear <> 2020 Then
DayOfJpnGymnasticDay = DateSerial(clng(iyear), 10, 14 - Weekday(DateSerial(iyear, 10, 0), 3))
ElseIf iyear = 2020 Then
DayOfJpnGymnasticDay = DateSerial(clng(iyear), 7, 24)
Else
DayOfJpnGymnasticDay = DateSerial(clng(iyear), 10, 10)
End If
End Function

Function DayofJpnCommingofAageDay(iyear) As Date
’敬老の日
If iyear >= 2000 Then
DayofJpnCommingofAageDay = DateSerial(iyear, 1, 14 - Weekday(DateSerial(iyear, 10, 0), 3))
Else
DayofJpnCommingofAageDay = DateSerial(iyear, 1, 15)
End If
End Function

Function DayofJpnCommingofAageDay(iyear) As Date
If clng(iyear) >= 2000 Then
DayofJpnCommingofAageDay = DateSerial(clng(iyear), 1, 14 - Weekday(DateSerial(iyear, 10, 0), 3))
Else
DayofJpnCommingofAageDay = DateSerial(clng(iyear), 1, 15)
End If
End Function

Function DayofJpnRespectForEldery(iyear) As Date
'成人の日
If clng(iyear) >= 2000 Then
DayofJpnRespectForEldery = DateSerial(iyear, 9, 21 - Weekday(DateSerial(iyear, 9, 0), 3))
Else
DayofJpnRespectForEldery = DateSerial(iyear, 9, 15)
End If
End Function

第5週の月曜日

2018年4月でやってみると

Function Mondayof5thon2018_04(iYear) As Date
Mondayof5thon2018_04 = DateSerial(iYear, 4, 35 - Weekday(DateSerial(iYear, 4, 0), 3))
End Function

これで4月30日月曜が返ります
一般的に第5週の月曜日があるか。
エラーになると 00:00:00 を返します。

Function Mondayof5thon2018_04(iYear, imonth) As Date
'第五月曜日があるか
Dim Dt As Date
Dt = DateSerial(iYear, imonth, 35 - Weekday(DateSerial(iYear, imonth, 0), 3))
If Month(Dt) < 5 Then
Mondayof5thon2018_04 = Dt
Exit Function
Else
Mondayof5thon2018_04 = vbEmpty
End If
End Function