次の「13日の金曜日」 リターン

２年ほど前に、↓こんなブログを書いていた。
infoment.hatenablog.com

読み返してみると、う～ん・・。当時の詳細な記憶は無いが、恐らくこれを書いた時は、未だ「Edate関数」を知らなかったに違いない。

この時のロジックは、

1. 金曜日が13日か調べる。
2. 13日でなければ、翌週の金曜日を調べる。
3. 1. に戻る。

といった感じで、ちまちまと７日ずつ調べている。

しかし考えてみれば、13日は毎月１回しかないわけで。
今書くなら、こんな感じだろうか。

Function Friday_the_13th(startDate As Date, _
                Optional nthTime As Long = 1) As Date
                
    Dim temp As Date
    ' 起算月の13日を求める。
    temp = Format(startDate, "yyyy/m/13")
    
    Do
        ' 13日の金曜日だった場合、指定回数をカウントダウン。
        If Weekday(temp) = vbFriday Then
            nthTime = nthTime - 1
        End If
        
        ' 指定回数が0になった時点でループを抜ける。
        If nthTime = 0 Then
            Exit Do
            
        ' 指定回数に満たない場合は、一月後の13日にtempを更新。
        Else
            temp = WorksheetFunction.EDate(temp, 1)
        End If
    Loop
    ' 13日の金曜日（＞＜）。
    Friday_the_13th = temp
End Function

コードの長さは殆ど違わないが、計算の回数は月と週の違いだから、25％ほど圧縮できたと思う。パソコンの性能を考えれば、気分だけの問題かもしれないが。

ということで、次回の「13日の金曜日」は、今年の11/13です。

参考まで。