次の「13日の金曜日」 - Infomentのブログ～Excel VBA奮闘記～

うっかりしていましたが昨日（2018/7/13)は、13日の金曜日でした。
商品の納入日に「大安」を選ばれる法人や個人は、勤め先のお客様に限って言えば、
今でも偶（たま～）にいらっしゃいます。そのことから考えると、13日の金曜日を
避けてという要望も、今後ひょっこり出てくるやもしれません（※１）
（※１　多分ありません）。

ということで、指定日から数えて次回の「13日の金曜日」を算出する、恐らく殆ど使いどころのない関数を作ってみました。

'============================================================
' Name     : Friday_the_13th
' Input    : startDate As Date・・・起算日
' Output   : 起算日の次の「13日の金曜日」
' Purpose  : 13日の金曜日に備える
' Remarks  :
' Author   : infoment
' Start    : 2018/7/14
' Version  : 1.1
'============================================================
Function Friday_the_13th(startDate As Date) As Date        
    Dim temp As Date        
    ' 起算日の次の金曜日を求める。
    temp = startDate + 8 - Weekday(startDate, vbFriday)
    ' 求めた金曜日が13日になるまで、7日加える。
    Do Until Day(temp) = 13
        temp = temp + 7
    Loop
    ' 13日の金曜日（＞＜）。
    Friday_the_13th = temp    
End Function

無事に、次回の13日（金）が求まりました。これで安心です。

f:id:Infoment:20180714095550p:plain

でもこれだと味気ないので、次の次、次の次の次・・・次の13日の金曜日も指定可能にしてみました。

'============================================================
' Name     : Friday_the_13th
' Input    :
'   startDate As Date   起算日
'   nthTime   As Long   ｎ回後（初期値＝１）
' Output   : 起算日の次の「13日の金曜日」
' Purpose  : 13日の金曜日に備える
' Remarks  :
' Author   : infoment
' Start    : 2018/7/14
' Version  : 1.1
'============================================================
Function Friday_the_13th(startDate As Date, _
                        Optional nthTime As Long = 1) As Date
    Dim temp As Date
    ' 次の金曜日を求める。
    temp = startDate + 8 - Weekday(startDate, vbFriday)
    ' 求めた金曜日が13日になるまで、7日加える。
    Do Until nthTime = 0
        temp = temp + 7
    ' 13日の金曜日だった場合、指定回数をカウントダウン。
        If Day(temp) = 13 Then
            nthTime = nthTime - 1
        End If
    Loop
    ' 13日の金曜日（＞＜）。
    Friday_the_13th = temp
End Function