Excelでスケジュール表（カレンダー）を自動作成する
Excelでスケジュール管理をする際にカレンダーの日付を横軸にとって表を作成していると思いますが、年月が変わる度に日付と曜日さらには土曜日と日曜日、祝日のセルの色を付け替える必要がでてきます。
今回は年月を変えるだけで自動的にカレンダーを作成できるアプリを作成しましたのでご紹介します。以下に記載したVBAのコードを所定の箇所に記載するだけで作成できますのでご活用ください。
サンプルアプリの使い方
下記表の黄色の箇所に年月を入力すると自動的にスケジュール表が作成されます。
年月を入力した時の処理内容
次のサンプルは、値を変更したセルがセルC3またはE3の場合にのみ、Change イベントが発生しカレンダーが作成されます。Change イベントにつきましてはこちらをご覧ください。Callで呼ばれている「Calendar作成」プロシージャーは次項の「カレンダー作成コード」に記載されている内容になります。
Private Sub Worksheet_Change(ByVal Target As Range)
'C3とE3セルの値に変更があったらカレンダーを再作成する。
If (Target.Row = 3 And Target.Column = 3) Or (Target.Row = 3 And Target.Column = 5) Then
'セルの値に変更があったときに下記のプロシージャを実行
Call Calendar作成
End If
End Sub上記コードはカレンダーを作成するシート内に記載します。
カレンダー作成コード アプリの作成手順はこちら
今回のカレンダー作成機能は祝日も考慮にいれて作成されるようにしています。
祝日については「祝日」シートに一覧を作成してカレンダーに情報を取り込んでします。
祝日の一覧を自動作成する方法は「こちらのリンク先」をご覧ください。
Option Explicit
Sub Calendar作成()
'カウント変数定義
Dim RowEnd As Integer
Dim Ext As Integer
Dim i As Integer
Dim j As Date
'日付変数定義
Dim DStart As Variant
Dim DEnd As Date
'2次元配列変数定義
Dim DSet As Variant
Dim Line As Integer
'データの最終行を取得
RowEnd = Cells(Rows.Count, 2).End(xlUp).Row
'C5セルを起点とした表の拡張行数を取得
Ext = RowEnd - 4
'カレンダー日付と罫線を削除
Range("C5").Resize(Ext, 31).Clear
Range("C5").Resize(Ext, 31).Borders.LineStyle = xlLineStyleNone
'指定月の初日をDStart変数にセット
DStart = DateSerial(Range("C3"), Range("E3"), 1)
'指定月の末日をDStart変数にセット
DEnd = DateSerial(Range("C3"), Range("E3") + 1, 0)
'２次元配列に日付をセット
ReDim DSet(1 To 2, 1 To 31)
i = 0
For j = DStart To DEnd
i = i + 1
DSet(1, i) = j '日を計算するための日付を2次元配列変数にセット
DSet(2, i) = j '曜日を計算するための日付を2次元配列変数にセット
Next
'C6セルを先頭にして日付欄と曜日欄に2次元配列の値をセット
Range("C5").Resize(2, 31) = DSet
'日付をもとに「日」と「曜日」に変換する
Range("C5").Resize(, 31).NumberFormatLocal = "d" '日付を「日」に変換
Range("C6").Resize(, 31).NumberFormatLocal = "aaa" '日付を「曜日」に変換
'日付と曜日を中央揃えで表示
Range("C5").Resize(2, 31).HorizontalAlignment = xlCenter
'罫線を描く
If Range("AE6") = "" Then
'29日が空欄だったら28日まで罫線を引く
Range("C5").Resize(Ext, 28).Borders.LineStyle = xlContinuous '罫線
Line = 28
ElseIf Range("AF6") = "" Then
'30日が空欄だったら29日まで罫線を引く
Range("C5").Resize(Ext, 29).Borders.LineStyle = xlContinuous '罫線
Line = 29
ElseIf Range("AG6") = "" Then
'31日が空欄だったら30日まで罫線を引く
Range("C5").Resize(Ext, 30).Borders.LineStyle = xlContinuous '罫線
Line = 30
Else
'上記以外だったら31日まで罫線を引く
Range("C5").Resize(Ext, 31).Borders.LineStyle = xlContinuous '罫線
Line = 31
End If
'日付と曜日の中心線を細線に変更
Range("C5").Resize(1, Line).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("C5").Resize(1, Line).Borders(xlEdgeBottom).Weight = xlHairline
'土曜日と日曜日のセルを着色する
For Each DStart In Range("C5").Resize(, 31)
If Format(DStart, "aaa") = "日" Then
'日曜日を塗りつぶし
DStart.Resize(Ext).Interior.Color = RGB(252, 228, 214)
ElseIf Format(DStart, "aaa") = "土" Then
'土曜日を塗りつぶし
DStart.Resize(Ext).Interior.Color = RGB(221, 235, 247)
End If
Next
Call 祝日のセルに色を付ける
End Sub
'-----------------------------------------------------------------------------------
Sub 祝日のセルに色を付ける()
'各種変数を定義
Dim i As Integer, r As Integer, Area1 As Range, Area2 As Range
'祝日シートのセルB4を含む表全体を変数「Area1」に代入
Set Area1 = Worksheets("祝日").Range("B4").CurrentRegion
'アクティブシート（カレンダー）のセルC5を含む表全体を変数「Area2」に代入
Set Area2 = Range("C5").CurrentRegion
'変数「Area2」に代入された表の日付部分の列数を取得して変数「r」に代入
r = Area2.Columns.Count - 1
'表の２列目以降（日付データ部分）のセルの範囲を変数「Area2」に代入し直す
'Set Area2 = Area2.Offset(, 1).Resize(, r)
'カレンダーの日付部分と祝日の日付部分を比較して、同じ箇所があったらセルを着色（LightYellow）する
For i = 1 To r
'「WorksheetFunction.COUNTIF（範囲, 検索値）=1」メソッドを使って祝日と同じ日付があったら着色
If WorksheetFunction.CountIf(Area1.Columns(1), Area2.Cells(1, i)) = 1 Then
Area2.Columns(i).Interior.Color = rgbLightYellow
End If
Next
End Sub