○箇月後の直近の○曜日は？

○箇月後の○曜日の日付を求める自作Function

「１箇月後の直近の木曜日を求める」という作業が発生した。別に、暦を見たらいいんだけれど、もし今後たくさんの日付について同じ作業をする必要が生じたらメンドウなので、ちょこちょこっと「１箇月後の直近の木曜日の日付」を返すFunctionプロシージャを作ってみた。

ただ、「１箇月後の直近の木曜日」にしか対応できないのではツマラナイので、

せめて○箇月後の○曜日ぐらいにはに対応できるようにしておこう

と思い立って、ちょこちょこっと書いてみた。

考え方

VBAには、組み込み定数でvbSunday（正体は"1"）～vbSaturday（正体は"7"）が定められている。

○箇月後の日付は、元の日付がtargetDateという変数に入っているとすると、

DateSerial(Year(targetDate), Month(targetDate) + ○, Day(targetDate))

で求められる。

で、その返り値（＝○箇月後の日付）がtmpDateという変数に入っているとすると、

Weekday(tmpDate)

で曜日を表す整数（"1"～"7"）が得られる。

あとは、そこから何日ずらせば求めたい曜日にたどり着くかを求め、tmpDateに入っている日付を調整すれば良いだけ。

それぞれの曜日をいくつずらせば求めたい曜日にたどり着くか、というのは規則性のあることなので、一覧表にすれば一般的な計算式が導き出せる。

○箇月後の曜日＼目的の曜日	vbSunday(1)	vbMonday(2)	vbTuesday(3)	vbWednesday(4)	vbThursday(5)	vbFriday(6)	vbSaturday(7)
vbSunday(1)	０	＋１	＋２	＋３	－３	－２	－１
vbMonday(2)	－１	０	＋１	＋２	＋３	－３	－２
vbTuesday(3)	－２	－１	０	＋１	＋２	＋３	－３
vbWednesday(4)	－３	－２	－１	０	＋１	＋２	＋３
vbThursday(5)	＋３	－３	－２	－１	０	＋１	＋２
vbFriday(6)	＋２	＋３	－３	－２	－１	０	＋１
vbSaturday(7)	＋１	＋２	＋３	－３	－２	－１	０

とまあ、こんな感じ。

目的の曜日を ｘ 、○箇月後の曜日を ｙ とすると、

1. ｘ－ｙ＞３のとき　（ｘ－ｙ）－７
2. －３≦ｘ－ｙ≦３のとき　ｘ－ｙ
3. ｘ－ｙ＜－３のとき　（ｘ－ｙ）＋７

で、それぞれ目的の曜日にするためにずらす日数が求められる。

コーディング

上記のことを踏まえてコーディングする。

引数は、

1. 元の日付
2. 何箇月後か
3. 直近の何曜日か

の３つ。もちろん、返り値は「○箇月後の○曜日の日付」である。

リスト１　標準モジュール

Option Explicit

Public Function calcAnyWeekdayAfterAnyMonths(ByVal targetDate As Date, _
                                             ByVal months As Integer, _
                                             ByVal weekDayAt As Integer) As Date
  If weekDayAt < 1 Or weekDayAt > 7 _
    Then Err.Raise 10001, "引数weekDayが不正です。"    '……(1)'
  Dim tmpDate As Date
  tmpDate = DateSerial(Year(targetDate), _
                       Month(targetDate) + months, _
                       Day(targetDate))    '……(2)'
  Dim objWeekday As Integer
  objWeekday = Weekday(tmpDate)    '……(3)'
  Dim adjustDateBy As Integer
  adjustDateBy = calcWeekday(weekDayAt, objWeekday)    '……(4)'
  calcAnyWeekdayAfterAnyMonths = tmpDate + adjustDateBy    '……(6)'
End Function

Private Function calcWeekday(ByVal tgtWeekday As Integer, _
                             ByVal objWeekday As Integer) As Integer    '……(5)'
  If (tgtWeekday - objWeekday) > 3 Then calcWeekday = tgtWeekday - objWeekday - 7: Exit Function
  If (tgtWeekday - objWeekday) >= -3 And _
     (tgtWeekday - objWeekday) <= 3 Then calcWeekday = tgtWeekday - objWeekday: Exit Function
  If (tgtWeekday - objWeekday) < -3 Then calcWeekday = tgtWeekday - objWeekday + 7
End Function

(1)の

If weekDayAt < 1 Or weekDayAt > 7 Then Err.Raise 10001, "引数weekDayが不正です。"

では、第３引数を調べ、整数の１～７以外が渡されていたらエラーを吐くようにしている。

(2)の

tmpDate = DateSerial(Year(targetDate), _
                       Month(targetDate) + months, _
                       Day(targetDate))

では、DateSerial関数によって、「months」箇月後の日付を取得。

(3)の

objWeekday = Weekday(tmpDate)

で「months」箇月後の日の曜日を取得。ちなみに、DateSerial関数を使っているので、例えば「１月30日の１箇月後」は、「２月30日」、すなわち平年ならば「３月２日」ということになるので注意。

ここまでで、「months」箇月後の曜日、目的の曜日の２つが判明しているので、(4)の

adjustDateBy = calcWeekday(weekDayAt, objWeekday)

で、これまた自作のcalcWeekday関数に２つの曜日を表す整数を渡して、調整すべき日数を求める。

(5)の

Private Function calcWeekday(ByVal tgtWeekday As Integer, _
                             ByVal objWeekday As Integer) As Integer
  If (tgtWeekday - objWeekday) > 3 Then calcWeekday = tgtWeekday - objWeekday - 7: Exit Function
  If (tgtWeekday - objWeekday) >= -3 And _
     (tgtWeekday - objWeekday) <= 3 Then calcWeekday = tgtWeekday - objWeekday: Exit Function
  If (tgtWeekday - objWeekday) < -3 Then calcWeekday = tgtWeekday - objWeekday + 7
End Function

で調整すべき日数を求める。３つの場合分けで、それぞれ計算方法を分岐。If～ElseIf～Elseで書けるけれど、そうすると読みづらくなるので、ガード節っぽい書き方で３つのIf文を連ねる形にした。

あとは、(6)の

calcAnyWeekdayAfterAnyMonths = tmpDate + adjustDateBy

で日数を調整して、結果を返す。

実行結果

2017年10月３日の１箇月後の直近の木曜日は、

このとおり。

2017年10月３日の２箇月後の直近の金曜日は、

このとおり。

2017年10月３日の３箇月後の直近の水曜日は、

このとおり。

おわりに

まあ、ここまでやったところで、使い道があるかどうかは不明ｗ

「車輪の再発明」でないことを祈る。

@akashi_keirin on Twitter

改訂しました

コチラもどうぞ。

akashi-keirin.hatenablog.com