【Excel VBA】４月始まりの年間カレンダーを自動作成

Sub カレンダー作成()
    Dim thisYear As Variant
    Dim nextYear As Variant
    Dim firstDay As Integer
    Dim days As Integer
    Dim row As Integer
    Dim col As Integer
    Dim febFlg As Boolean
    '年度のカレンダーを作成するか入力
    thisYear = Application.InputBox("西暦を半角4桁の数字で入力してください。")
    'キャンセル時の処理
    If thisYear = False Then
        Exit Sub
    End If
    '4桁でない場合の処理
    If Len(thisYear) <> 4 Then
        MsgBox ("西暦は4桁で入力してください。" _
            & vbCrLf & "作業を中止します。")
        Exit Sub
    End If
    '次年度分の変数を用意
    nextYear = thisYear + 1
    '年間カレンダーの中身をリセットする
    For i = 3 To 48 Step 15
       Range(Cells(i, 1), Cells(i + 11, 23)).ClearContents
    Next
    '月間カレンダー各シートの中身をリセットする
    For i = 2 To 13
         Sheets(i).Range("A3:G14").ClearContents
    Next
    '年を入力
    Range("A1").Value = thisYear & "年"
    Range("A46").Value = nextYear & "年"
    '4月1日の曜日を取得、最初に入力する列を決定
    firstDay = Weekday(thisYear + "/04/01")
    col = firstDay
    '年間カレンダーを作成
    For i = 1 To 46 Step 15
        For j = 7 To 23 Step 8
            row = i + 2
            '各月の日数を算出
            Select Case Cells(i, j).Value
                Case "4月", "6月", "9月", "11月"
                    days = 30
                Case "2月"
                    febFlg = False
                    '2月の場合は閏年を判定
                    If nextYear Mod 400 <> 0 Then
                        If nextYear Mod 100 = 0 Then
                             days = 28
                        ElseIf nextYear Mod 4 = 0 Then
                            days = 29
                            febFlg = True
                        Else
                            days = 28
                        End If
                    Else
                        days = 29
                        febFlg = True
                    End If
                Case Else
                    days = 31
            End Select
            '１ヶ月分の日付を入力
            For k = 1 To days
                Cells(row, col).Value = k
                If col = j Then
                    row = row + 2
                    col = j - 6
                Else
                     col = col + 1
                End If
                If k = days Then
                    If j = 23 Then
                        col = col - 16
                    Else
                        col = col + 8
                    End If
                 End If
             Next k
        Next j
    Next i
    '月間カレンダーを作成
    col = firstDay
    For i = 2 To 13
        With Sheets(i)
            '年を入力
            If i >= 11 Then
                .Range("F1").Value = nextYear & "年"
            Else
                .Range("F1").Value = thisYear & "年"
            End If
            '各月の日数を算出
            Select Case i
                Case 2, 4, 7, 9
                    days = 30
                Case 12
                    If febFlg = True Then
                        days = 29
                    Else
                        days = 28
                    End If
                Case Else
                    days = 31
            End Select
            row = 3
            '各シートに1ヶ月分の日付を入力
            For j = 1 To days
                .Cells(row, col).Value = j
                If col = 7 Then
                    row = row + 2
                    col = 1
                Else
                    col = col + 1
                End If
                If j = days Then
                    row = 3
                End If
            Next j
        End With
    Next i
End Sub