パソコン同好会の7〜9月の予定日をExcel VBAで作った

麻里府パソコン同好会の 月間予定日 は、Excel で作り、［Webページとして保存］したものであるが、平成23年度から（午前中を隔週にしたため）作るのが難しくなった。で、

マクロで簡単に作りたい‥‥と思っているばかりで進まなかったが、この二日間で［H23.07-09］（タブで切り替える）の月/日だけではあるが出来るようになった。

§Excel のイメージ

まず、ワークシート関数で考え方を整理した。

4〜7行目：予定の「標準パターン」を持つことにした。
- キーは、「奇数曜日/偶数曜日」と「火曜日/金曜日」と2項目。こうなるとExcel では対応できない（たぶん）ことから、これらを合わせた E列を設けた。
- 例えば、セルE4=C4*10+D4。
8行目：講座時間の縦計。時間に差が出ないようにするための参考値。
- 例えば、セルF8=COUNTIF(F9:F35,"○")*3、セルH8=COUNTIF(H9:H35,"○")*1.5。
C列：第*曜日かで、B列の日付から日を取り出し、7で割って切り上げる。
- 例えば、セルC9=ROUNDUP(DAY(B9)/7,0)。
D列：曜日コード
- 例えば、セルD9=WEEKDAY(B9)。
E列：標準パターンを索引するためのキー
- 例えば、セルE9=(2-MOD(C9,2))*10+D9。
F〜N列
- 例えば、セルF9=INDEX($F$4:$N$7,MATCH($E9,$E$4:$E$7,0),1)。

§解ったことおよび今後の課題

完成したVBA は、長いので後述した。

Index関数でセルの値を取得すると、空白だった場合 0 が返る。空白を得たいのであれば、スペースを入力しておく必要がある。
8行目の講座時間の合計を計算する CouniIf関数は、その範囲の行を削除すると式が壊れる。VBA で計算式も入力できる？ VBA で行う範囲か？は、次の予定を作る時に考えることにする。
今回作成した VBA は、予定日を作るだけ。
　セルの書式設定等（条件付き書式や罫線）、行列の非表示/再表示は、別途、マクロで行う予定。

§使い方（メモ）

ブックを開く
次の3ヶ月の予定を作る場合は、シートをコピーする。
9行目以下を削除する。
- これにより、8行目の関数が壊れる。
マクロ：開会日セットを実行する。
開始月を入力する。
手動で修正する。
［上書き保存］する。
列、行を非表示にして、
［Webページとして保存］する。

§完成したVBA

Option Explicit
Dim mbTitle As String

Public Sub 開会日セット()
Const kikan As Long = 3
Const SRow As Long = 9  '9行目
Const SCol As Long = 2  'B列
Dim SYear As Long, SMonth As Long, SDay As Long
Dim i As Long
Dim rowCTR As Long, lastRow As Long
Dim Ans01 As Long
Dim SDate As Date, EDate As Date
Dim is1st As Boolean

    mbTitle = "マクロ：開会日セット"
    If Cells(SRow, SCol) <> "" Then
        If MsgBox("データが残っています！" & vbCrLf & vbCrLf _
            & "このまま続けると「ゴミ」が残る可能性があります。" _
            , vbOKCancel + vbExclamation, mbTitle) = vbCancel Then Exit Sub
    End If
    
    SMonth = Month(Date) + 1
    SMonth = InputBox("開始月を入力してください。" _
        & vbCrLf & vbCrLf & "0 を入力すると、キャンセルします。" _
        , mbTitle, SMonth)
    If SMonth = 0 Then Exit Sub
    
    SYear = Year(Date)
    If SMonth <= Month(Date) Then SYear = SYear + 1
    SDate = DateSerial(SYear, SMonth, 1)
    EDate = DateSerial(SYear, SMonth + kikan, 0)
    is1st = True
    For i = 0 To 6
        Ans01 = Weekday(SDate)
        If Ans01 = 3 Or Ans01 = 6 Then
            If is1st Then
                is1st = False
                Cells(SRow, SCol) = SDate
            Else
                Cells(SRow + 1, SCol) = SDate
            End If
        End If
        SDate = DateAdd("d", 1, SDate)
    Next
    lastRow = 0
    For i = 0 To 1
        SDate = DateAdd("d", 7, Cells(SRow + i, SCol))
        rowCTR = SRow + i
        Do While SDate <= EDate
           rowCTR = rowCTR + 2
           Cells(rowCTR, SCol) = SDate
           SDate = DateAdd("d", 7, SDate)
        Loop
        If rowCTR > lastRow Then lastRow = rowCTR
    Next
    For i = SRow To lastRow
            '第*曜日かをセットする。
        Cells(i, SCol + 1) = Fix(Day(Cells(i, SCol)) / 7) + 1
            '曜日コードをセットする。
        Cells(i, SCol + 2) = Weekday(Cells(i, SCol))
            '検索キーをセットする。
        Cells(i, SCol + 3) = (2 - Cells(i, SCol + 1) Mod 2) * 10 + Cells(i, SCol + 2)
            'ﾜｰｸｼｰﾄ関数 Match を使って、標準パターンの行番号を取得する。
        Ans01 = Application.WorksheetFunction _
                .Match(Cells(i, 5), Range("E4:E7"), 0)
            '標準ﾊﾟﾀｰﾝを一括ｺﾋﾟｰし、
        Range(Cells(Ans01 + 3, 6), Cells(Ans01 + 3, 14)).Select
        Selection.Copy
            'F列のセルに貼り付ける。
        Cells(i, 6).Select
        ActiveSheet.Paste
    Next
End Sub