Excelでカレンダーを作ってみる

出荷一覧をカレンダーに表示

【Excel】Excel でカレンダーを作ってみるを見たからではないのですが、
実は、カレンダーに年月指定で、出荷状況を表示する機能を作っていました。
最初のは余りにも力技で、そのままのコードは汚いので、少し見易く整理をしました。

カレンダー本体は、テーブル

カレンダー本体(名前はSKCAL_)とコントロールテーブル(名前はCAL_)はテーブルで作成します。

関数を２つに分けました

無理やり１つの関数にまとめると雑になりすぎるので、日付部分と出荷状況表示の２つに分けました。
CALAは、年月からカレンダー日付のシリアル値を求める関数です。
日付計算が何故IF文なのかですが、IFC で纏めると循環していると判断されるようです。
年月で発火すればいいので、参照先のテーブルは、文字列で定義しても問題ないようです。
DateSerialの結果を変数で受けるのは面倒なので、２回計算しています。

Function CALA(年, 月, Optional T = "SKCAL_", Optional S = 0)
    Dim R: Set R = Range(T)
    Dim M: M = MM(R)
    Dim N: N = NN(R)

    If M = 1 And N = 1 Then
        S = DateSerial(年, 月, 1) - Weekday(DateSerial(年, 月, 1)) + 1
    Else
        S = DI(R, 1, 1) + 7 * Int(M / 2) + N - 1
    End If
    CALA = S
End Function

CALBは、出荷一覧（名前はSK_）から日付をキーにデータを持ってきて編集し表示します。
CALAで計算した日付シリアルを引数Dで受けて発火してくれるので、出荷一覧テーブルは文字列指定で問題ないようです。
調子にのって引数全部をOPTIONALにすると、再計算してくれなくなるようです。

Function CALB(D, C, Optional S = "")
    Dim 年, 機, 番号, W, O, 製品名, 発注, 依頼, 日付, 出庫, 済, 在庫, I, J, K
    J = MI(Range("SK_[日付]"), D)
    K = Range("SK_").Rows.Count

    For I = 1 To K
        If J = "" Then Exit For

        Call DR(Range("SK_"), J + I - 1, 年, 機, 番号, W, O, 製品名, 発注, 依頼, 日付, 出庫, 済, 在庫)

        If 日付 <> D Then Exit For

        If W > 0 Then 製品名 = CC(製品名, "(W", TF(W, "000"), ")")
        S = CC(S, Left(CC(製品名, SP(15)), 17), " ", TF(出庫, "###0"), IFC(機 = 1, "本", "個") _
                                                                     , IFC(済 = 0, "", C), vbNewLine)
    Next I
    CALB = S
End Function

Sub DR(R, I, ParamArray PA())               ' DATA READ
    Dim J: For J = 0 To UBound(PA)
        PA(J) = DI(R, I, J + 1)
    Next J
End Sub

使用法

１行１列(B3):　=CALA(CAL_[年],CAL_[月])
２行１列(B4):　=CALB(B3,CAL_[済])

と定義し、B3,B4を纏めてCOPYし、関数で全体にPASTEして下さい。

以上