SPILL関数でカレンダーを作成してみる。

以前投稿した　Excelでカレンダーを作ってみるをSPILLで書き直してみました。

今回は、下記の２か所に関数を埋め込むだけですので、簡単です。
(B1) =CC(CAL_[年],"年",CAL_[月],"月")
(B2) =CAL(CAL_[年],CAL_[月],CAL_[済],CAL_[U])

関数CALは、配列を初期化する QL_INIT()と、日付がマッチしたデータを編集して返すCALD()を呼んでいます。
日付がマッチするデータ位置の配列を返す関数 COMP_()と、
それから得られた抽出条件からデータを絞り込む関数FILTER_()を使用しています。

Function CAL(年, 月, C, U, Optional S = "")
    Dim I, J
    
    S = QL_INIT(12, "日,月,火,水,木,金,土")
    
    S(1, 1) = DateSerial(年, 月, 1) - Weekday(DateSerial(年, 月, 1)) + 1
    
    For I = 3 To 11 Step 2
        S(I, 1) = S(I - 2, 1) + 7
    Next I
    For I = 1 To 11 Step 2
        For J = 2 To 7
            S(I, J) = S(I, J - 1) + 1
        Next J
    Next I
    For I = 2 To 12 Step 2
        For J = 1 To 7
            S(I, J) = CALD(S(I - 1, J), C)
        Next J
    Next I

    CAL = S
End Function

Function QL_INIT(M, N, Optional L1 = 1, Optional L2 = 1, Optional S = "")
    On Error Resume Next
    If TR_(M) Then
        S = QL_INIT(M.Rows.Count, N, L1, L2)

    ElseIf TV_(M) Then
        S = QL_INIT(UBound(M, 1), N, L1, L2)

    ElseIf TS_(M, N) Then
        L = Split(M, " "): M = UBound(L) - LBound(L) + 1
        T = Split(N, ","): N = UBound(T) - LBound(T) + 1
        S = QL_INIT(M, N, 0, 1)
        For I = 1 To M: S(I, 1) = L(I - 1): Next I
        For J = 1 To N: S(0, J) = T(J - 1): Next J

    ElseIf TS_(N) Then
        T = Split(N, ","): N = UBound(T) - LBound(T) + 1
        S = QL_INIT(M, N, 0, 1)
        For J = 1 To N: S(0, J) = T(J - 1): Next J
        
    ElseIf TS_(L1) Then
        T = Split(L1, ",")
        N = UBound(T, 1) + 1
        S = QL_INIT(M, N, 0, 1)
        For J = 1 To N: S(0, J) = T(J - 1): Next J
        
    Else
        ReDim S(L1 To M, L2 To N)
        For J = L2 To N: For I = L1 To M: S(I, J) = "": Next I: Next J
    End If

    QL_INIT = S
End Function

Function CALD(D, Optional C = "*", Optional M01 = "", Optional M02 = "", Optional S = "")
    On Error Resume Next
    
    抽出条件 = COMP_("M01N_[日付]", D)
    
    If WorksheetFunction.Sum(抽出条件) > 0 Then

        M01A = FILTER_("M01N_[製品名]", 抽出条件)
        M01B = FILTER_("M01N_[[出庫]:[済]]", 抽出条件)
        M01W = FILTER_("M01N_[W]", 抽出条件)
    
        For I = 1 To UBound(M01A, 1)
            Call DR(M01A, I, 製品名)
            Call DR(M01B, I, 出庫, 済)
            Call DR(M01W, I, W)
         
            WS = IFC(InStr(製品名, "共通") = 0, 17, 15)
         
            If W > 0 Then 製品名 = CC(製品名, "(W", TF(W, "#00"), ")")
            S = CC(S, Left(CC(製品名, SP(WS)), WS), " ", TF(出庫, "###0"), "本", IFC(済 = 1, C, ""), vbNewLine)
        Next I
    End If
    
    抽出条件 = COMP_("M02N_[日付]", D)

    If WorksheetFunction.Sum(抽出条件) > 0 Then
        
        M01A = FILTER_("M02N_[製品名]", 抽出条件)
        M01B = FILTER_("M02N_[[出庫]:[済]]", 抽出条件)
    
        For I = 1 To UBound(M01A, 1)
            Call DR(M01A, I, 製品名)
            Call DR(M01B, I, 出庫, 済)
                     
            S = CC(S, Left(CC(製品名, SP(15)), 15), " ", TF(出庫, "###0"), "個", IFC(済 = 1, C, ""), vbNewLine)
        Next I
    End If
    CALD = S
End Function

Function COMP_(R, D, Optional S = "") ' COMPARE
    On Error Resume Next
    If TS_(R) Then Set R = Range(R)

    S = R
    
    Dim I: For I = 1 To UBound(S, 1)
        If S(I, 1) = D Then S(I, 1) = 1 Else S(I, 1) = 0
    Next I
    
    COMP_ = S
End Function

Function FILTER_(R, F)
    If TS_(R) Then Set R = Range(R)
    
    FILTER_ = WorksheetFunction.Filter(R, F, "")
End Function

関数CAL()の引数に、CAL_[U]が入っていますが、シートに下記の関数を定義して、アクティブになったら再計算させています。

Private Sub Worksheet_Activate()
    U = Range("CAL_[U]")
    
    Range("CAL_[U]") = (U + 1) Mod 2
End Sub