年月週の表ラベルを作成する

昨日まで、指定した開始日から最終日までに含まれる週の数を知るために、クラスモジュールを作成していた。
infoment.hatenablog.com
目的は、↓ のような変換を行う必要に迫られたため。

そこで今日は、まず、年月週の表ラベルを作成することに挑戦する。

今回は、ラベル相当の配列を作成する関数を、昨日までのクラスモジュールに追加してみた。

クラスモジュール（DateObjectClass）

Public Function 配列_年月週(開始日 As Date, 最終日 As Date) As Variant

    ' 開始日と終了日から、その間が何週間あるかを求める。
    Dim WeekCount As Long
        ' 引数Falseを指定することで、月を跨ぐ週の数を「2」でカウントしている｡
        WeekCount = 指定日間週数(開始日, 最終日, False)

    ' 週が連続するように、受け皿として配列を設ける。
    Dim seq() As Variant
    ReDim seq(1 To 3, 1 To WeekCount)

    ' 各月が何週間あるかを、配列にセットする。
    ' ※indexは、開始月数から始まっている。
    ' 　例えば開始日が３月の場合、LBound(NumberOfWeeksInEachMonth) = 3 となる｡
    Dim NumberOfWeeksInEachMonth As Variant
        NumberOfWeeksInEachMonth = 各月週数(開始日, 最終日)

    ' 配列に年月週を入れ込んでいく。
    ' 12で割っているのは、開始日から最終日までに発生する年越しに対応するため。
    Dim i As Long
    Dim j As Long
    Dim k As Long
    ' 小文字のエルが１やＩ（アイ）に見えるので、大文字で使用。
    Dim L As Long: L = 1
        For i = LBound(NumberOfWeeksInEachMonth) To UBound(NumberOfWeeksInEachMonth)
            
            ' 開始日月だけは、週が1から始まらない。
            Select Case i
                Case LBound(NumberOfWeeksInEachMonth)
                    k = 当月第何週(開始日)
                Case Else
                    k = 1
            End Select
            
            For j = k To k + NumberOfWeeksInEachMonth(i) - 1
                If L = 1 Then
                    seq(1, L) = Year(開始日)
                Else
                    seq(1, L) = seq(1, 1) + _
                                         WorksheetFunction.RoundDown((i - 1) / 12, 0)
                End If
                seq(2, L) = (i - 1) Mod 12 + 1
                seq(3, L) = j
                L = L + 1
            Next
        Next
        
        配列_年月週 = seq
End Function

標準モジュール

試しにこれを、シートに貼り付けてみる。

Sub Test()
    Dim DObj As DateObjectClass
    Set DObj = New DateObjectClass
    
    Dim seq As Variant
        seq = DObj.配列_年月週(開始日:="2019/3/19", 最終日:="2019/5/10")

    With Range("A1").Resize(3, UBound(seq, 2))
        .Value = seq
        .Rows(1).NumberFormatLocal = "0000年"
        .Rows(2).NumberFormatLocal = "0月"
        .Rows(3).NumberFormatLocal = "第0週"
    End With
End Sub

↓ 結果がこちら。

取り敢えず、まずまずといったところか。
明日に続きます。

参考まで。