指定日から直近の翌営業日を求める

昨日は、指定月の最終金曜日を求める関数を紹介しました。

infoment.hatenablog.com

この時の勉強会で、最後にこんな質問が出ました。

「毎月20日になったら、MsgBox でメッセージを出したい」

詳細は、次の通りです。

• アドインに組み込むことで、特定の日付にメッセージを出すところまで実装済み。
• 20日が土日だと、気付かずに20日を通り過ぎてしまうため、これを何とかしたい。

そこで、翌月１日から逆算して最終金曜日を求めた方法を応用して、２０日の翌営業日を求めてみました。

Function GetNextWorkday(target_date As Date) As Date

    Dim TargetWorkdayNumber As Long
        TargetWorkdayNumber = Weekday(target_date, vbSaturday)
        Select Case TargetWorkdayNumber
            Case Is <= 2
                GetNextWorkday = target_date + 3 - TargetWorkdayNumber
            Case Else
                GetNextWorkday = target_date
        End Select
        
End Function

２０日が土曜日または日曜日の場合は翌月曜日とするために、今回も土曜日始まりにしています。

結果、２０日が金・土曜の場合も、正しく月曜日の日付を得ることが出来ました。

ただし、この方式には二つの弱点があります。

1. 土曜日または日曜日が出勤日の場合に対応できない
2. 月曜日が祝祭日または定休日の場合に対応できない

これに対応するためには、例えば上記をまとめたテーブルを作成し、

Function GetNextWorkday(target_date As Date, _
                        HolidayTable As ListObject) As Date

のような感じで、同テーブルを引数として渡すなどの方法があります。
毎年テーブルを更新する必要があるため、割と面倒だったりします。

参考まで。