作成した年月週の表ラベルに実際の値を充て込んでみる ④ 完

昨日は、作成した年月週の表ラベルに既存の値を転記し、更に重複する文字をラベルから消してみた。
infoment.hatenablog.com
今日は、今回の最終回。入出庫情報を元に、在庫の推移表として編集してみる。
f:id:Infoment:20190323214448p:plain

現時点での表は、こんな感じだ。
f:id:Infoment:20190323214823p:plain

この表の最終目的は、依頼者によれば、週次での在庫推移確認とのこと。従って、初期在庫さえわかれば、後は入出庫情報を加算すれば目的の表が完成する。

では仮に「りんご」「みかん」「ばなな」の初期在庫が１０個であるとして、在庫の推移を確認してみよう。

Sub testoooooooooooo()
    Dim Dict As Dictionary
    Set Dict = GetTableDict(Range("B1").CurrentRegion)
    
    Dim rMax As Long
        rMax = Range("B1").CurrentRegion.Rows.Count
    
    Dim DObj As DateObjectClass
    Set DObj = New DateObjectClass
    Dim seq As Variant
        
        ' 週が連続する配列を取得。
        seq = DObj.配列_年月週("2019/3/1", "2019/4/27")
        
        ' データの分だけ配列を拡張。
    Dim SQC As SeaquenceClass
    Set SQC = New SeaquenceClass
        seq = SQC.ExtractArray2(seq, , rMax)
            
    Dim myKey As Long
    Dim c As Long
    Dim r As Long
        ' 各列の年月週が辞書に存在する場合、その値をセットする。
        For c = 1 To UBound(seq, 2)
            myKey = seq(1, c) & Format(seq(2, c), "00") & Format(seq(3, c), "00")
            If Dict.Exists(myKey) Then
                For r = 1 To UBound(Dict.Keys) - 1
                    seq(r + 3, c) = Dict(myKey)(r)
                Next
            End If
        Next
        
        ' 年月から、重複するものを削除する。
        For r = 1 To 2
            For c = UBound(seq, 2) To 2 Step -1
                If seq(r, c) = seq(r, c - 1) Then
                    seq(r, c) = vbNullString
                End If
            Next
        Next
    
    ' 初期在庫。今回はコードに直接入力するが、実際には引数で受け取っても良い。
    ' 一旦、配列を拡張して、そこに初期在庫をセットする。
    ' ※存在しなかった０番を差し込むが、配列は１始まりで変わらないことに注意。
        seq = SQC.ExtractArray2(seq, , , 0)
        For r = 4 To rMax
            seq(r, 1) = 10
        Next
    
    ' 初期在庫と各週の入出庫情報から、各週の在庫数を算出。
        For c = 2 To UBound(seq, 2)
            For r = 4 To rMax
                seq(r, c) = seq(r, c - 1) + seq(r, c)
            Next
        Next
    
    ' 不要な初期在庫列を除く。
        seq = SQC.ExtractArray2(seq, , , 2)
    
    ' 編集を終えた配列を張り付けて、各行を書式設定。
        With Range("B1").Resize(UBound(seq, 1), UBound(seq, 2))
            .Value = seq
            ' 年の書式設定
            .Rows(1).NumberFormatLocal = "0000年"
            ' 月の書式設定
            .Rows(2).NumberFormatLocal = "0月"
            ' 週の書式設定
            .Rows(3).NumberFormatLocal = "第0週"
        End With
End Sub