月を跨ぐ週の数を「2」と数えてみる - Infomentのブログ～Excel VBA奮闘記～

必要に迫られて、月を跨ぐ週を別物として扱うことになった。
例えば、↓こんな感じ。
f:id:Infoment:20190317130058p:plain

これを踏まえたうえで、例えば４月１日～５月３１日までの週数を求めたい。
色々と関数を作ってみたが、場合分けごとに関数が増えてしまい、扱いがとても煩雑になってしまった。そのため、それらをクラスモジュールで詰め合わせてみた。

クラスモジュール（DateObjectClass）

最初は英語名だったモジュール名も、似たようなものが多数出現してピンと来なくなったため、思い切ってほとんど日本語にしてある。また、検討の過程で生まれて結局使用しなかったものも、そのまま残してある。

Option Explicit

Public Function 当月第何週(指定日 As Date) As Long
        当月第何週 = WorksheetFunction.WeekNum(指定日) - _
                     WorksheetFunction.WeekNum(当月初日(指定日)) _
                     + 1
End Function

Private Function 単純指定日間週数(開始日 As Date, 最終日 As Date) As Long
        単純指定日間週数 = WorksheetFunction.WeekNum(最終日) - _
                           WorksheetFunction.WeekNum(開始日) _
                           + 1
End Function

Public Function 当月残週数(指定日 As Date) As Long
        当月残週数 = 月内指定日間週数(指定日, 当月最終日(指定日))
End Function

Public Function 当月初日(指定日 As Date) As Date
        当月初日 = DateSerial(Year(指定日), Month(指定日), 1)
End Function

Public Function 当月最終日(指定日 As Date) As Date
        当月最終日 = 翌月一日(指定日) - 1
End Function

Public Function 翌月一日(指定日 As Date) As Date
        翌月一日 = DateSerial(Year(指定日), Month(指定日) + 1, 1)
End Function

Public Function 翌月最終日(指定日 As Date) As Date
        翌月最終日 = DateSerial(Year(翌月一日(指定日)), Year(翌月一日(指定日)), 1) - 1
End Function

Public Function 当月週数(指定日 As Date) As Long
        当月週数 = 単純指定日間週数(当月初日(指定日), 当月最終日(指定日))
End Function
Public Function 指定日間週数(開始日 As Date, 最終日 As Date, Optional 月末月初の重複可 As Boolean = True) As Long

    ' 開始日と最終日が月を跨いでいて、且つ、同じ週である場合、
    ' 二つの週を合わせて「１」とカウントする。
    If 月末月初の重複可 = True Then
        指定日間週数 = 単純指定日間週数(開始日, 最終日)
    Else
        指定日間週数 = WorksheetFunction.Sum(各月週数(開始日, 最終日))
    End If

End Function

Public Function 各月週数(開始日 As Date, 最終日 As Date) As Variant
    Dim 月数 As Long
        月数 = DateDiff("m", 開始日, 最終日)

    Dim seq() As Variant
    ReDim seq(Month(開始日) To Month(開始日) + 月数)

        Select Case 月数
            Case 0
                seq(Month(開始日)) = 単純指定日間週数(開始日, 最終日)
            Case 1
                seq(Month(開始日)) = 単純指定日間週数(開始日, 当月最終日(開始日))
                seq(Month(開始日) + 月数) = 単純指定日間週数(翌月一日(開始日), 最終日)
            Case Else
                seq(Month(開始日)) = 単純指定日間週数(開始日, 当月最終日(開始日))
                seq(Month(開始日) + 月数) = 単純指定日間週数(当月初日(最終日), 最終日)
                Dim i As Long
                Dim tempDate As Date
                    tempDate = 翌月一日(開始日)
                    For i = LBound(seq) + 1 To UBound(seq) - 1
                        seq(i) = 当月週数(tempDate)
                        tempDate = 翌月一日(tempDate)
                    Next
        End Select

        各月週数 = seq
End Function

標準モジュール

毎度のごとく、標準モジュールはアッサリとしている。

Function 週数(開始日 As Date, 終了日 As Date, Optional 重複可 As Boolean = True) As Long
    Dim DObj As DateObjectClass
    Set DObj = New DateObjectClass
        週数 = DObj.指定日間週数(開始日, 終了日, 重複可)
End Function