【簡単エクセル/Excel VBA マクロ】シフト表・当番表付きカレンダーを作成する｜カレンダ作成Part3｜アプリ事例 #008
運営者・ポテ
いつもありがとうございます。
ノンプログラマー向け「Excel VBA マクロ アプリ事例解説シリーズ」へようこそ。
本稿では、カレンダー作成アプリのPart2として「シフト表・当番表付きカレンダーを作成する」アプリをお届けいたします。
プレーンなカレンダーを作成するアプリはこちらで紹介しておりますので、もしよろしければご覧くださいませ。
前回は、プレーンなカレンダーを作成するアプリを紹介しました。これはこれで余計なクセがなくて良いのですが、実務で使うカレンダーであれば、もう少し気が利いたカレンダーであっても良いでしょう。
単に日付を確認したいのであれば、PCの右下の日付のところをクリックするとカレンダーが出てきますからね。わざわざExcelでオリジナルのカレンダーを作成する必要はないです。
Excelでオリジナルのカレンダーを作成するときというのは、日付確認以外の別の目的がある場合がほとんどです。（私のように趣味でコードを書いているような方以外には...）
その中でも需要が多いと思われるのが、今回扱う「シフト表・当番表」ですね。アルバイトのシフト表、昼勤・夜勤のシフト表、電話当番表、掃除当番表、ごみ捨て当番表、朝礼担当表、見回り担当表、雪国だと雪かき当番表などです。仮にご家庭であれば、家事当番表、ペットのお世話当番表などが挙げられるでしょう。
このようなシフト表や当番表の作成を手作業で行うのは、非常に時間がかかりますし、ミスも起こりがちです。しかし、このような作業は、VBAを使えば簡単に自動化することができます。
また、自動化して効率化できるだけでなく、本稿の後半で紹介する「ランダムにシフト・当番を割り当てる」機能を使えば、さらにありがたい利点があります。
人が当番を決める場合、多かれ少なかれ決める人の意思が感じられ、思わぬ不公平感が生じることがあります。たとえば、大雪予報の日に雪かき当番を割り当てられたり、ごみが大量に出ると分かっている日にごみ捨て当番に割り当てられたりする場合です。決める側に対して心中穏やかでない方もいるかもしれません。しかし、これを人の意思が介在しないアプリが自動で作ったとなれば、恨みようもありません。
これは、たとえば、会議やセミナーでも有効です。会議やセミナーを主催する方は、質問や問題の回答者を指名するときに、いつも指名しやす方、つまり、いつも同じ方に偏ってしまうことがあります。こうした場合も、恨みっこなしで回答者を指名できます。
いかがでしょう。便利ですよね。最近のトレンドである心理的安全性の構築にも貢献するでしょう。
VBAで自分に合ったアプリを作成し、仕事量は半分に、成果は2倍にしていきましょう。初心者でも理解しやすいように、分かりやすく解説していきます。ぜひご覧ください。
VBAで「シフト表・当番表」を作成する方法
アプリの仕様
Excelシート上で、シフト表や当番表の対象となる「年」と「月」、および「シフト名・当番名」を入力し、アプリを実行します。
そうすると、新しいワークブックが作成され、その中のワークシートに、入力した情報を基にしたシフト表・当番表付きのカレンダーが生成されます。
カレンダー各週の行数は、入力したシフト名・当番名の数に応じて自動調整されます。
作成した新規ワークブックは保存しますが、すぐに中身を確認できるよう、閉じずに開いたままにしておきます。
Excelシートの設計
本アプリケーションでは、諸条件を指定するためのExcelワークシートが必要です。下図のようなワークシートを準備しましょう。
「年」「月」入力用セルと、「シフト名・当番名」入力用セルがあります。アプリケーションで、これらのセルの情報を読み取ってカレンダーを作成します。
また、これらのセルの下に、アプリケーション実行開始用の「カレンダーを作成する」というボタンを配置しています。このボタンにマクロを登録し、クリックするとマクロが動作するように設定します。マクロの登録手順については、後述いたします。
コードの実装
このアプリケーションを実現するコードと、その実行結果を示します。
コードは次の通りです。
Option Explicit
Sub CreateCalendar()
' 変数:
' Workbook/Worksheet 関連
Dim this_wb As Workbook ' 現在のブック
Dim this_ws1 As Worksheet ' 現在のブックの1つ目のシート
Dim new_wb As Workbook ' 新しく作成するブック
Dim new_ws1 As Worksheet ' 新しく作成するブックの1つ目のシート
Dim new_window As Window ' 新しいブックのウィンドウ
' ユーザー入力関連
Dim user_input_year As Long ' ユーザーが入力した年
Dim user_input_month As Long ' ユーザーが入力した月
Dim user_input_shift_name_range As Range ' シフト名が入力されるセル範囲
Dim shift_names_array() As Variant ' シフト名を格納する配列
Dim shift_name_count As Long ' シフト名の数
Dim cell As Range ' 配列ループ用変数
' カレンダー生成関連
Dim last_day_of_month As Long ' 指定した月の最終日
Dim column_idx As Long ' 曜日に基づく列インデックス
Dim row_idx As Long ' カレンダー描画時の行インデックス
Dim day_counter As Long ' 日数カウンター
Dim weekday_name As String ' 曜日名 (例: 月、火...)
Dim title_cell As Range ' 年月タイトルを入力するセル
Dim rows_per_week As Long ' 週ごとに確保する行数
Dim row_position As Long ' 枠線調整のための行位置
' シフト・当番関連
Dim shift_row_idx As Long ' シフト名書き込み用の行インデックス
Dim array_write_idx As Long ' シフト配列への書き込み用インデックス
' 定数
Const START_ROW As Long = 3 ' カレンダーの開始行
Const START_COLUMN As Long = 3 ' カレンダーの開始列
' 現在のワークブックとワークシートを変数に代入
Set this_wb = ThisWorkbook
Set this_ws1 = this_wb.Worksheets(1)
' 新しいカレンダー用のワークブックとワークシートを作成
Set new_wb = Workbooks.Add
Set new_ws1 = new_wb.Worksheets(1)
' 年と月を設定
user_input_year = this_ws1.Cells(11, 4)
user_input_month = this_ws1.Cells(11, 5)
' 年月データが不正である場合、処理を中断
If user_input_year = 0 Or user_input_month = 0 Then
MsgBox "年月データが不正です。処理を中断します。", vbExclamation
new_wb.Close SaveChanges:=False
Exit Sub
End If
' カレンダーのタイトル（年と月）を新しいシートに書き込み
Set title_cell = new_ws1.Cells(START_ROW - 1, START_COLUMN - 1)
title_cell.Value = "'" & user_input_year & "年" & user_input_month & "月"
' 月の最終日を取得
last_day_of_month = Day( _
DateSerial(user_input_year, user_input_month + 1, 1) - 1 _
)
' 行インデックスの初期化
row_idx = START_ROW
' シフト名格納用の配列用を初期化:
' データ範囲を設定
Set user_input_shift_name_range = _
this_ws1.Range(this_ws1.Cells(17, 5), this_ws1.Cells(26, 5))
' 要素数取得
shift_name_count = WorksheetFunction.CountA(user_input_shift_name_range)
' シフト名・当番名が設定されていない場合、処理を中断
If shift_name_count = 0 Then
MsgBox "シフト名・当番名が設定されていません。処理を中断します。", vbExclamation
new_wb.Close SaveChanges:=False
Exit Sub
End If
' ▼▼▼
Debug.Print "<シートに書き込まれている要素数の検証>"
Debug.Print shift_name_count
Debug.Print ""
' ▲▲▲
' 配列サイズの初期化
ReDim shift_names_array(1 To shift_name_count)
array_write_idx = 1 ' 書き込みインデックス初期化
' データ範囲を走査し、配列に格納
For Each cell In user_input_shift_name_range
If cell.Value <> "" Then
shift_names_array(array_write_idx) = cell.Value
array_write_idx = array_write_idx + 1
End If
Next cell
' ▼▼▼
Debug.Print "<配列に格納されている要素数の検証>"
Debug.Print UBound(shift_names_array)
Debug.Print ""
' ▲▲▲
' ▼▼▼
Debug.Print "<配列に格納されている要素名の検証>"
array_write_idx = 1
For array_write_idx = LBound(shift_names_array) To UBound(shift_names_array)
Debug.Print array_write_idx, shift_names_array(array_write_idx)
Next array_write_idx
' ▲▲▲
' 各週の行数を設定
rows_per_week = shift_name_count + 2
' 各日付のループ処理
For day_counter = 1 To last_day_of_month
' 曜日名（例: 月、火、水...）を取得
weekday_name = WeekdayName( _
Weekday( _
DateSerial(user_input_year, user_input_month, day_counter), _
vbSunday _
), _
True _
)
' 曜日から列インデックスを計算（列の位置を設定）
column_idx = Weekday( _
DateSerial(user_input_year, user_input_month, day_counter), vbSunday _
) + START_COLUMN - 1
' 日付と曜日をカレンダーに入力
With new_ws1.Cells(row_idx, column_idx)
.Value = day_counter
End With
With new_ws1.Cells(row_idx + 1, column_idx)
.Value = weekday_name
End With
' 曜日ごとにフォントカラーを設定
Select Case weekday_name
Case "土"
new_ws1.Cells(row_idx, column_idx).Font.ColorIndex = 5
new_ws1.Cells(row_idx + 1, column_idx).Font.ColorIndex = 5
Case "日"
new_ws1.Cells(row_idx, column_idx).Font.ColorIndex = 3
new_ws1.Cells(row_idx + 1, column_idx).Font.ColorIndex = 3
End Select
' 日付、曜日、シフトエアリのセルを中央寄せに設定
Range( _
new_ws1.Cells(row_idx, column_idx), _
new_ws1.Cells(row_idx + rows_per_week, column_idx) _
).HorizontalAlignment = xlCenter
' 行インデックス次の週に進める：
' もし月内最終日でなければ
If Not day_counter = last_day_of_month Then
' もし土曜日なら次の行に移動
If column_idx = START_COLUMN + 6 Then _
row_idx = row_idx + rows_per_week
End If
Next day_counter
' シフト名の書き込み
array_write_idx = 1
For shift_row_idx = START_ROW + 2 To row_idx + 2 Step rows_per_week
' 配列に格納されているすべての要素名を書き込む
For array_write_idx = LBound(shift_names_array) To UBound(shift_names_array)
new_ws1.Cells(shift_row_idx + array_write_idx - 1, START_COLUMN - 1) = shift_names_array(array_write_idx)
Next array_write_idx
Next shift_row_idx
' カレンダーの枠線を作成
new_ws1.Range( _
new_ws1.Cells(START_ROW, START_COLUMN - 1), _
new_ws1.Cells(row_idx + rows_per_week - 1, START_COLUMN + 6) _
).Borders.LineStyle = xlContinuous
' ▼▼▼ 枠線範囲の検証 ▼▼▼
Debug.Print "枠線の開始行: " & START_ROW
Debug.Print "枠線の開始列: " & START_COLUMN - 1
Debug.Print "枠線の終端行: " & row_idx + rows_per_week - 1
Debug.Print "枠線の開始列: " & START_COLUMN + 6
' ▲▲▲
' 水平枠線の調整：行ごとの枠線を非表示にし、薄い枠線を追加
For row_position = START_ROW To row_idx + 1 Step rows_per_week
' 枠線非表示
Range( _
new_ws1.Cells(row_position, START_COLUMN - 1), _
new_ws1.Cells(row_position + 1, START_COLUMN + 6) _
).Borders(xlInsideHorizontal).LineStyle = xlNone
' 薄い枠線
Range( _
new_ws1.Cells(row_position + 1, START_COLUMN - 1), _
new_ws1.Cells(row_position + rows_per_week - 1, START_COLUMN + 6) _
).Borders(xlInsideHorizontal).Weight = xlHairline
Next row_position
' グリッド線を非表示にする
Set new_window = Application.Windows(new_wb.Name)
new_window.DisplayGridlines = False
' カレンダを保存する
new_wb.SaveAs (ThisWorkbook.Path & "\シフト表.xlsx")
End Subこのコードを実行すると、次のようなシフト表・当番表がカレンダー形式で作成されます。
解説していきます。
Option Explicitここでは、Option Explicit を有効にしています。この設定を使うと、変数を使用する前に必ず宣言が必要になります。これにより、変数のタイプミスや未定義変数によるエラーを防ぎ、コードの安全性と信頼性を高めることができます。
' 変数:
' Workbook/Worksheet 関連
Dim this_wb As Workbook ' 現在のブック
Dim this_ws1 As Worksheet ' 現在のブックの1つ目のシート
Dim new_wb As Workbook ' 新しく作成するブック
Dim new_ws1 As Worksheet ' 新しく作成するブックの1つ目のシート
Dim new_window As Window ' 新しいブックのウィンドウ
' ユーザー入力関連
Dim user_input_year As Long ' ユーザーが入力した年
Dim user_input_month As Long ' ユーザーが入力した月
Dim user_input_shift_name_range As Range ' シフト名が入力されるセル範囲
Dim shift_names_array() As Variant ' シフト名を格納する配列
Dim shift_name_count As Long ' シフト名の数
Dim cell As Range ' 配列ループ用変数
' カレンダー生成関連
Dim last_day_of_month As Long ' 指定した月の最終日
Dim column_idx As Long ' 曜日に基づく列インデックス
Dim row_idx As Long ' カレンダー描画時の行インデックス
Dim day_counter As Long ' 日数カウンター
Dim weekday_name As String ' 曜日名 (例: 月、火...)
Dim title_cell As Range ' 年月タイトルを入力するセル
Dim rows_per_week As Long ' 週ごとに確保する行数
Dim row_position As Long ' 枠線調整のための行位置
' シフト・当番関連
Dim shift_row_idx As Long ' シフト名書き込み用の行インデックス
Dim array_write_idx As Long ' シフト配列への書き込み用インデックス
' 定数
Const START_ROW As Long = 3 ' カレンダーの開始行
Const START_COLUMN As Long = 3 ' カレンダーの開始列ここでは、コード内で使用する変数が宣言されています。変数は Dim 変数名 As データ型 の構文で宣言します。これにより、各変数は As 以降で指定したデータ型のデータを格納できるようになります。
ワークブックやワークシート、ユーザー入力値（年や月）、カレンダー構造、配列などのカテゴリごとに整理し、可動性を良くしています。
なお、各データ型の意味は下表の通りです。
| データ型 | 種類 | 意味 |
|---|---|---|
| Workbook | オブジェクト型 | Excelのワークブック（ファイル）を操作するためのデータ型です。 |
| Worksheet | オブジェクト型 | Excelのワークシートを操作するためのデータ型です。 |
| Window | オブジェクト型 | Excelのウィンドウを操作するためのデータ型です。 |
| Long | 数値型 | 数値を扱うデータ型です。-2,147,483,648 から 2,147,483,647 までの範囲の整数を格納できます。 |
| Range | オブジェクト型 | Excelシート内のセル範囲を操作するためのデータ型です。 |
| Variant | 汎用型 | 任意のデータを扱う柔軟なデータ型です。 |
| String | 文字列型 | テキスト情報を扱うためのデータ型です。 |
' 定数
Const START_ROW As Long = 3 ' カレンダーの開始行
Const START_COLUMN As Long = 3 ' カレンダーの開始列ここでは、コード内で使用する固定値を定数として宣言しています。値を直接ハードコーディングせず定数化することで、コードの可読性と保守性が向上します。変更が必要になった場合でも、定数を修正するだけで全体に反映されるため、管理が容易になります。
' 現在のワークブックとワークシートを変数に代入
Set this_wb = ThisWorkbook
Set this_ws1 = this_wb.Worksheets(1)ここでは、現在のワークブック（Thisworkbook）とワークシート（this_wb.Worksheets(1)）を取得し、それぞれthis_wsとthis_ws1というオブジェクト変数に代入しています。なお、ThisWorkbook は現在のワークブック、つまりこのコードが記述されているワークブックを指します。
' 新しいカレンダー用のワークブックとワークシートを作成
Set new_wb = Workbooks.Add
Set new_ws1 = new_wb.Worksheets(1)ここでは、まずカレンダー用の新しいワークブックを作成（Workbooks.Add）し、1枚目（左端）のワークシートを、それぞれnew_wbとnew_wsというオブジェクト変数に代入しています。のちの処理で、このワークシート上にカレンダを描画します。
' 年と月を設定
user_input_year = this_ws1.Cells(11, 4)
user_input_month = this_ws1.Cells(11, 5)推敲↓
ここでは、Excelシートの指定されたセルに入力された値を変数に格納しています。具体的には、セル this_ws1.Cells(11, 4) に入力された「年」の情報を user_input_year に、セル this_ws1.Cells(11, 5) に入力された「月」の情報を user_input_month に代入しています。なお、Cells(行番号, 列番号) で示されるセルアドレスは、下図に示す位置を指しています。
' 年月データが不正である場合、処理を中断
If user_input_year = 0 Or user_input_month = 0 Then
MsgBox "年月データが不正です。処理を中断します。", vbExclamation
new_wb.Close SaveChanges:=False
Exit Sub
End Ifここは、年月データが不正な場合、具体的にはセルに空白である場合に、エラーメッセージを表示し、処理を中断（Exit Sub）する処理です。
変数user_input_yearとuser_input_monthは、数値型（Long）として宣言されているため、セルが空白の場合、0を返します。そのため、If条件では、0を検知するようにしています。
' カレンダーのタイトル（年と月）を新しいシートに書き込み
Set title_cell = new_ws1.Cells(START_ROW - 1, START_COLUMN - 1)
title_cell.Value = "'" & user_input_year & "年" & user_input_month & "月"ここでは、前述の処理で新しく作成されたシート（new_ws1）の上部のセルに、カレンダーのタイトルとして「年」（user_input_year）と「月」（user_input_month）を入力しています。このように、カレンダーの上部に年月情報を表示し、ユーザーが何年何月のカレンダーなのかを一目で判別できるようにしています。
なお、Cells(START_ROW - 1, START_COLUMN - 1)は、cells(開始行の1つ上、曜日開始列のひとつ左)を指します。つまり、カレンダーの左上の方に年月情報が表示されるように指定しています。
' 月の最終日を取得
last_day_of_month = Day( _
DateSerial(user_input_year, user_input_month + 1, 1) - 1 _
)ここでは、指定された年月の最終日を取得しています。翌月の1日から1日を引くことで、指定月の最終日を計算する仕組みです。
' 行インデックスの初期化
row_idx = START_ROWここでは、行走査用のインデックスを初期化しています。具体的には、行インデックスの初期値を定数 START_ROWに設定しています。
' シフト名格納用の配列用を初期化:
' データ範囲を設定
Set user_input_shift_name_range = _
this_ws1.Range(this_ws1.Cells(17, 5), this_ws1.Cells(26, 5))ここでは、ユーザーがシフト名を入力するセル範囲を取得し、オブジェクト変数user_input_shift_name_rangeに代入しています。このようにオブジェクト変数に割り当てておくことで、後続の処理ではこの変数を通じてセル範囲に操作を加えることができます。そのため、コードがシンプルで分かりやすくなります。
' 要素数取得
shift_name_count = WorksheetFunction.CountA(user_input_shift_name_range)ここでは、上述のセル範囲において、空白ではないセルの数をWorkSheetFunctionを用いてカウントしています。「空白ではないセルの数」というのは、つまり、「ユーザーが入力したシフト名・当番名の数」です。これは、後の処理で配列のサイズ調整（初期化）や、各週の行数の設定、エラーハンドリングなどの使用されます。
' シフト名・当番名が設定されていない場合、処理を中断
If shift_name_count = 0 Then
MsgBox "シフト名・当番名が設定されていません。処理を中断します。", vbExclamation
new_wb.Close SaveChanges:=False
Exit Sub
End Ifここでは、エラーハンドリングを行っています。具体的には、シフト名・当番名の数が、「0」で合った場合は、警告メッセージを非表示し、処理を中断（Exit Sub）します。
' ▼▼▼
Debug.Print "<シートに書き込まれている要素数の検証>"
Debug.Print shift_name_count
Debug.Print ""
' ▲▲▲ここでは、セルに入力されているシフト名・当番名の数を検証しています。これは、デバッグ情報を出力しているだけであり、アプリケーションの機能に何ら影響しません。しかし、後にアプリケーションのテストを行う場合に、便利であるため記述しています。削除、またはコメントアウトしていただいても問題ありません。
' 配列サイズの初期化
ReDim shift_names_array(1 To shift_name_count)ここでは、配列のサイズを初期化（設定）しています。この配列には後でシフト名を格納しますが、動的配列は初期状態ではサイズが未定義です。そのため、ReDimステートメントを使用して、配列の範囲を1からshift_name_countまでに設定しています。これにより、指定された数のシフト名を正しく格納できるようになります。
array_write_idx = 1 ' 書き込みインデックス初期化
' データ範囲を操作し、配列に格納
For Each cell In user_input_shift_name_range
If cell.Value <> "" Then
shift_names_array(array_write_idx) = cell.Value
array_write_idx = array_write_idx + 1
End If
Next cellここでは、ワークシートのセルから取得したシフト名・当番名を、配列（shift_names_array）に格納しています。
具体的には、次の手順で動作しています。
- 配列への書き込み位置を示す変数を初期化します。具体的には、
array_write_idxを1に設定します。 For Eachループを使い、user_input_shift_name_range内の各セルを順に処理します。If cell.Value <> "" Thenの条件で、セルの値が空白でない場合のみ処理を実行します。空白セルは無視されます。つまり、空白セルは配列に格納されません。- 条件を満たしたセルの値を、配列
shift_names_arrayの位置array_write_idx番目に格納します。 - 次のデータを格納するために、
array_write_idxに1を加算してインデックスを進めます。 - ループを繰り返し、範囲内のすべてのセルが処理されるまで進みます。
配列に格納したシフト名・当番名は、後のカレンダー作成にて使用します。
なお、For...Each ループに関しては、こちらの記事で解説しております。もしよろしければ、合わせてご覧ください。
' ▼▼▼
Debug.Print "<配列に格納されている要素数の検証>"
Debug.Print UBound(shift_names_array)
Debug.Print ""
' ▲▲▲ここでは、配列（shift_names_array）入力されているシフト名・当番名の数を検証しています。これは、デバッグ情報を出力しているだけであり、アプリケーションの機能に何ら影響しません。しかし、後にアプリケーションのテストを行う場合に、便利であるため記述しています。削除、またはコメントアウトしていただいても問題ありません。
' ▼▼▼
Debug.Print "<配列に格納されている要素名の検証>"
array_write_idx = 1
For array_write_idx = LBound(shift_names_array) To UBound(shift_names_array)
Debug.Print array_write_idx, shift_names_array(array_write_idx)
Next array_write_idx
' ▲▲▲ここでは、配列（shift_names_array）入力されているシフト名・当番名を検証しています。こちらも、削除、またはコメントアウトしていただいても問題ありません。
' 各週の行数を設定
rows_per_week = shift_name_count + 2ここでは、各週の行数を何行にするかを指定しています。ここでの行数とは、下図で示した行のことを指しています。ユーザーが入力したシフト名・当番名の数（shift_name_count）の分だけ、行数を設ける仕組みです。
shift_name_count + 2の2は、タイトル行（日付と曜日の行）の行数です。タイトル行には、常に2行を使いますので、固定値で2を加算しています。
' 各日付のループ処理
For day_counter = 1 To last_day_of_month
' 曜日名（例: 月、火、水...）を取得
weekday_name = WeekdayName( _
Weekday( _
DateSerial(user_input_year, user_input_month, day_counter), _
vbSunday _
), _
True _
)
' 曜日から列インデックスを計算（列の位置を設定）
column_idx = Weekday( _
DateSerial(user_input_year, user_input_month, day_counter), vbSunday _
) + START_COLUMN - 1
' 日付と曜日をカレンダーに入力
With new_ws1.Cells(row_idx, column_idx)
.Value = day_counter
End With
With new_ws1.Cells(row_idx + 1, column_idx)
.Value = weekday_name
End With
' 曜日ごとにフォントカラーを設定
Select Case weekday_name
Case "土"
new_ws1.Cells(row_idx, column_idx).Font.ColorIndex = 5
new_ws1.Cells(row_idx + 1, column_idx).Font.ColorIndex = 5
Case "日"
new_ws1.Cells(row_idx, column_idx).Font.ColorIndex = 3
new_ws1.Cells(row_idx + 1, column_idx).Font.ColorIndex = 3
End Select
' 日付、曜日、シフトエアリのセルを中央寄せに設定
Range( _
new_ws1.Cells(row_idx, column_idx), _
new_ws1.Cells(row_idx + rows_per_week, column_idx) _
).HorizontalAlignment = xlCenter
' 行インデックス次の週に進める：
' もし月内最終日でなければ
If Not day_counter = last_day_of_month Then
' もし土曜日なら次の行に移動
If column_idx = START_COLUMN + 6 Then _
row_idx = row_idx + rows_per_week
End If
Next day_counterここは一連の処理ですが、コードが長いため細分化して説明していきます。本アプリのメインのカレンダー作成の部分です。
' 各日付のループ処理
For day_counter = 1 To last_day_of_monthここでは、1日から月末までの日付を、ひとつずつ順に処理する繰り返し処理を開始しています。
なお、For...Next 構文に関しては、こちらの記事で解説しております。もしよろしければ、合わせてご覧ください。
' 曜日名（例: 月、火、水...）を取得
weekday_name = WeekdayName( _
Weekday( _
DateSerial(user_input_year, user_input_month, day_counter), _
vbSunday _
), _
True _
)ここでは、指定した日付の曜日名（例: 月、火、水など）を取得しています。DateSerial で日付を生成し、Weekday でその曜日を数値化した後、WeekdayName を使って対応する曜日名を文字列で取得しています。
' 曜日から列インデックスを計算（列の位置を設定）
column_idx = Weekday( _
DateSerial(user_input_year, user_input_month, day_counter), vbSunday _
) + START_COLUMN - 1ここでは、指定した日付に対応する列インデックス（曜日に基づく列番号）を計算しています。Weekday で曜日を数値化し、START_COLUMN を考慮してカレンダーの列位置を決定しています。
なお、Weekday が返す数値と、それに対応する曜日は下表の通りです。vbSunday を基準にした対応表です。bSunday は、VBAで曜日を扱う際の定数で、「週の始まりを日曜日とする」ことを意味します。
Weekday の戻り値 |
対応する曜日 |
|---|---|
| 1 | 日曜日 |
| 2 | 月曜日 |
| 3 | 火曜日 |
| 4 | 水曜日 |
| 5 | 木曜日 |
| 6 | 金曜日 |
| 7 | 土曜日 |
' 日付と曜日をカレンダーに入力
With new_ws1.Cells(row_idx, column_idx)
.Value = day_counter
End With
With new_ws1.Cells(row_idx + 1, column_idx)
.Value = weekday_name
End Withここでは、カレンダーに「日付」と「曜日」を入力しています。次のような仕組みになっています。
- 日付
new_ws1.Cells(row_idx, column_idx)に日付を表す数値（day_counter）を入力しています。 - 曜日
日付セルの下（new_ws1.Cells(row_idx + 1, column_idx)）に対応する曜日（weekday_name）を入力しています。
これにより、カレンダー上で日付とその対応する曜日が適切な位置に表示されます。
' 曜日ごとにフォントカラーを設定
Select Case weekday_name
Case "土"
new_ws1.Cells(row_idx, column_idx).Font.ColorIndex = 5
new_ws1.Cells(row_idx + 1, column_idx).Font.ColorIndex = 5
Case "日"
new_ws1.Cells(row_idx, column_idx).Font.ColorIndex = 3
new_ws1.Cells(row_idx + 1, column_idx).Font.ColorIndex = 3
End Selectここでは、土曜日と日曜日のフォントの色を変更しています。ユーザーがカレンダーを見やすくするためです。
具体的には、Select Case を使用して、weekday_name の値に基づいて処理を分岐しています。次のような仕組みになっています。
- 土曜日
weekday_nameが"土"の場合、日付セルと曜日セルのフォントカラーをColorIndex = 5（青）に設定します。 - 日曜日
weekday_nameが"日"の場合、日付セルと曜日セルのフォントカラーをColorIndex = 3（赤）に設定します。
なお、Select Case に関してはこちらの記事で解説しております。もしよろしければ、合わせてご覧ください。
' 日付、曜日、シフトエアリのセルを中央寄せに設定
Range( _
new_ws1.Cells(row_idx, column_idx), _
new_ws1.Cells(row_idx + rows_per_week, column_idx) _
).HorizontalAlignment = xlCenterここでは、日付、曜日、シフト入力エリアのセルを中央寄せに設定しています。Range 関数で、日付セル（new_ws1.Cells(row_idx, column_idx)）からその週全体の範囲（new_ws1.Cells(row_idx + rows_per_week, column_idx)）を指定し、この範囲の HorizontalAlignment プロパティに xlCenter を設定することで、水平方向に中央寄せしています。
' 行インデックス次の週に進める：
' もし月内最終日でなければ
If Not day_counter = last_day_of_month Then
' もし土曜日なら次の行に移動
If column_idx = START_COLUMN + 6 Then _
row_idx = row_idx + rows_per_week
End If
Next day_counterここでは、日付のループ処理内で行インデックスを次の週に進めるロジックを実行しています。
まず、If Not day_counter = last_day_of_month Then の条件で、現在処理している日付が月の最終日でない場合にのみ処理を続行します。
その後、If column_idx = START_COLUMN + 6 Then により、現在の列が土曜日の位置かどうかを判定します。土曜日であれば、次の週に進むために row_idx に rows_per_week を加算して行インデックスを更新します。
このループを繰り返すことで、カレンダーが正しい形式で描画されます。
' シフト名の書き込み
array_write_idx = 1
For shift_row_idx = START_ROW + 2 To row_idx + 2 Step rows_per_week
' 配列に格納されているすべての要素名を書き込む
For array_write_idx = LBound(shift_names_array) To UBound(shift_names_array)
new_ws1.Cells(shift_row_idx + array_write_idx - 1, START_COLUMN - 1) = shift_names_array(array_write_idx)
Next array_write_idx
Next shift_row_idxここでは、シフト名をカレンダーに書き込む処理を行っています。次のような仕組みになっています。
- 外側のループ
For shift_row_idx = START_ROW + 2 To row_idx + 2 Step rows_per_weekでは、週ごとにシフト名を入力する行（shift_row_idx）を進めています。Step rows_per_weekによって、1週間分の行をスキップしながら処理を行います。 - 内側のループ
For array_write_idx = LBound(shift_names_array) To UBound(shift_names_array)では、配列shift_names_arrayに格納されたすべてのシフト名を順番に取り出しています。 - 取り出したシフト名を
new_ws1.Cells(shift_row_idx + array_write_idx - 1, START_COLUMN - 1)に入力しています。このロジックにより、配列内のシフト名が縦に並ぶ形で適切なセルに配置されます。
この処理により、各週のエリアにシフト名が入力されます。
' カレンダーの枠線を作成
new_ws1.Range( _
new_ws1.Cells(START_ROW, START_COLUMN - 1), _
new_ws1.Cells(row_idx + rows_per_week - 1, START_COLUMN + 6) _
).Borders.LineStyle = xlContinuousここでは、カレンダー全体に枠線を作成しています。Range でカレンダーの左上から右下まですべての範囲を指定し、その範囲の Borders.LineStyle に xlContinuous を設定することで、連続した線の枠線を適用しています。
' ▼▼▼ 枠線範囲の検証 ▼▼▼
Debug.Print "枠線の開始行: " & START_ROW
Debug.Print "枠線の開始列: " & START_COLUMN - 1
Debug.Print "枠線の終端行: " & row_idx + rows_per_week - 1
Debug.Print "枠線の開始列: " & START_COLUMN + 6
' ▲▲▲ここでは、カレンダーに適用した枠線の範囲が正しいかどうかを検証しています。これも、前述のDebug.Printのセクションと同様に、デバッグ情報を出力しているだけであり、アプリケーションには何ら影響しません。アプリケーションのテストを簡単にするために、実装しています。削除、またはコメントアウトしていただいても問題ありません。
' 水平枠線の調整：行ごとの枠線を非表示にし、薄い枠線を追加
For row_position = START_ROW To row_idx + 1 Step rows_per_week
' 枠線非表示
Range( _
new_ws1.Cells(row_position, START_COLUMN - 1), _
new_ws1.Cells(row_position + 1, START_COLUMN + 6) _
).Borders(xlInsideHorizontal).LineStyle = xlNone
' 薄い枠線
Range( _
new_ws1.Cells(row_position + 1, START_COLUMN - 1), _
new_ws1.Cells(row_position + rows_per_week - 1, START_COLUMN + 6) _
).Borders(xlInsideHorizontal).Weight = xlHairline
Next row_positionここでは、カレンダーの水平枠線を調整しています。各週の行のまとまりの中で、水平枠線を非表示にするところと、薄い線にするところがあり、その処理を行っています。具体的には、次のような仕組みになっています。
For row_position = START_ROW To row_idx + 1 Step rows_per_weekのループを開始し、週ごとの行のまとまりに対して繰り返し処理を実行します。- 各週の開始位置（
row_position）に対応する行で、Range関数を使用して指定範囲の水平枠線（xlInsideHorizontal）を非表示（LineStyle = xlNone）にします。これにより、既存の枠線が消えます。 - その後、
row_position + 1からrow_position + rows_per_week - 1の範囲に薄い水平枠線（Weight = xlHairline）を設定します。この処理でカレンダー内の区切り線が整います。 Next row_positionにより、次の週の位置に進み、同様の調整を繰り返します。
' カレンダを保存する
new_wb.SaveAs (ThisWorkbook.Path & "\シフト表.xlsx")ここでは、作成したカレンダーを保存しています。new_wb.SaveAs を使用して、現在のブック（ThisWorkbook）が存在するフォルダに「シフト表.xlsx」という名前で保存しています。
以上で「シフト表・当番表付きカレンダーを作成する方法」の解説は終了です。ありがとうございました。
VBAで「シフト表・当番表付きカレンダー」にランダムに担当を割り当てる方法
アプリの仕様
前セクションで作成したシフト表・当番表付きカレンダーに、ランダムに担当者を割り当てます。
Excelシート上で、「担当者名」を入力し、アプリを実行します。
そうすると、担当者がランダムに選ばれ、カレンダーに設定されます。
この際、担当者は、入力した担当者の中から、シフト・当番の数の分だけランダムに選ばれ、設定されます。
たとえば、この記事の例であれば、5人の担当者の中から毎日ランダムに3人が選ばれます。これをその月の日数分だけ繰り返し、ひと月のカレンダーが完成します。
作成した新規ワークブックは保存しますが、すぐに中身を確認できるよう、閉じずに開いたままにしておきます。
Excelワークシートの設計
前セクションと同様に、担当者を指定するためのExcelワークシートが必要です。下図のようなワークシートを準備しましょう。
「担当者」入力用セルがあります。アプリケーションで、このセルの情報を読み取ってカレンダーに出力します。
また、こちらも前セクションと同様に、プリケーション実行開始用の「担当者をランダムに割り当てる」というボタンを配置しています。このボタンにマクロを登録し、クリックするとマクロが動作するように設定します。マクロの登録手順については、後述いたします。
なお、このワークシートは次のように、前セクションの内容とつなげて作成するのが良いでしょう。
コードの実装
担当者をランダムに割り当てるコードと、その実行結果を示します。
コードは以下の通りです。
Sub AssignDuty()
' 変数宣言
' Workbook/Worksheet 関連
Dim this_wb As Workbook ' 現在のワークブック
Dim this_ws As Worksheet ' 現在のワークシート
Dim des_wb As Workbook ' 目的のワークブック
Dim des_ws As Worksheet ' 目的のワークシート
Dim des_file_path As String ' 目的のファイルパス
' ユーザー入力関連
Dim user_input_name_range As Range ' 担当者名が入力されるセル範囲
Dim cell As Range ' 配列ループ用変数
Dim user_input_name_array() As Variant ' 担当者名を格納する配列
Dim name_count As Long ' 担当者名をカウントする変数
Dim array_write_idx As Long ' 配列書き込み用インデックス
' インデックス関連
Dim des_last_row As Long ' 目的シートの最終行
Dim des_row_idx As Long ' 行インデックス
Dim des_col_idx As Long ' 列インデックス
Dim cell_write_idx As Long ' シフト名をセルに書き込むインデックス
' 定数宣言
Const START_ROW As Long = 5
Const START_COL As Long = 3
Const LAST_COL As Long = START_COL + 6
Const rows_per_week As Long = 5
' Thisworkbook を取得
Set this_wb = ThisWorkbook
Set this_ws = this_wb.Worksheets(1)
' 対象ファイルのパスを生成
des_file_path = ThisWorkbook.Path & "\シフト表.xlsx"
' 対象ワークブックを開く
Set des_wb = Workbooks.Open(des_file_path)
Set des_ws = des_wb.Worksheets(1)
' 終端行の取得
des_last_row = des_ws.Cells(des_ws.Rows.Count, 2).End(xlUp).Row
' ▼▼▼
Debug.Print "<終端行の検証>"
Debug.Print "終端行: " & des_last_row & vbCrLf
' ▲▲▲
' 従業員配列の初期化:
' データ範囲を取得
Set user_input_name_range = this_ws.Range(this_ws.Cells(41, 5), this_ws.Cells(50, 5))
' 要素数取得
name_count = WorksheetFunction.CountA(user_input_name_range)
' 要素数が0である場合、処理を中断
If name_count = 0 Then
MsgBox "担当者データが不正です。処理を中断します。", vbExclamation
Exit Sub
End If
' 配列サイズの初期化
ReDim user_input_name_array(1 To name_count)
' データ範囲を操作し、配列に格納
array_write_idx = 1
For Each cell In user_input_name_range
If cell.Value <> "" Then
user_input_name_array(array_write_idx) = cell.Value
array_write_idx = array_write_idx + 1
End If
Next cell
' ▼▼▼
Debug.Print "<配列に格納されている要素数の検証>"
Debug.Print UBound(user_input_name_array) & vbCrLf
' ▲▲▲
' ▼▼▼
Debug.Print "<配列に格納されている要素名の検証>"
array_write_idx = 1
For array_write_idx = LBound(user_input_name_array) _
To UBound(user_input_name_array)
Debug.Print array_write_idx, user_input_name_array(array_write_idx)
Next array_write_idx
Debug.Print ""
' ▲▲▲
' シード値の初期化
Randomize
' 外側: 行を走査
des_row_idx = START_ROW
For des_row_idx = START_ROW To des_last_row Step rows_per_week
' 当番列のセルが空白でなければ
If des_ws.Cells(des_row_idx, 2) <> "" Then
' 内側: 列を走査
For des_col_idx = START_COL To LAST_COL
' 曜日のセルが空白でなければ
If des_ws.Cells(des_row_idx - 1, des_col_idx) <> "" Then
' フィッシャー・イェーツのシャッフルを呼び出してランダムな配列を生成
FisherYatesShuffle user_input_name_array
' カレンダに担当者を書き込み
For cell_write_idx = 1 To 3
des_ws.Cells( _
des_row_idx + cell_write_idx - 1, des_col_idx _
) _
= user_input_name_array(cell_write_idx)
Next cell_write_idx
End If
Next des_col_idx
End If
Next des_row_idx
' ワークブックを保存
des_wb.Save
' ▼▼▼
Debug.Print "<処理範囲の検証>"
Debug.Print "開始行: " & START_ROW
Debug.Print "開始列: " & START_COL
Debug.Print "終端行: " & des_last_row
Debug.Print "終端列: " & LAST_COL & vbCrLf
' ▲▲▲
End Sub
Sub FisherYatesShuffle(ByRef employees_array As Variant)
' 変数宣言
Dim array_index As Long
Dim random_index As Long
Dim swapping_value As String
' Fisher-Yatesアルゴリズムで配列をシャッフル
For array_index = UBound(employees_array) _
To LBound(employees_array) + 1 Step -1
' ランダムなインデックスを生成
random_index = Int( _
(array_index - LBound(employees_array) + 1) * Rnd) _
+ LBound(employees_array _
)
' 配列内の値を交換
swapping_value = employees_array(array_index)
employees_array(array_index) = employees_array(random_index)
employees_array(random_index) = swapping_value
Next array_index
End Subこのコードを実行すると、次のようにランダムに担当者が割り当てられます。
解説していきます。
大変申し訳ございません。ただいま解説を執筆中でございます。少々ご猶予くださませ。
ボタンにマクロを登録する方法
次にボタンにマクロを登録する方法を解説します。
ボタンにマクロを登録し、これをクリックすることによりマクロが動くようにします。これをすることにより、いちいち表示メニューからマクロを実行する必要がなくなり、作業効率が上がります。アプリをコミュニティに配布するのであれば、ユーザーの使い勝手を考えてこのようにしておくと親切です。
次のアプリ画面を例に解説します。
まず、ボタンの上で「右クリック」し、「マクロの登録」を選択します。
次のようなダイアログが表示されますので、該当のマクロ名を選択し、「OK」を押下します。この例では、「CreateCalendar」ですが、ここは実際のマクロ名にしてください。
以上でマクロの登録は完了です。
これで、ボタンをクリックするとマクロが動くようになりました。
以上で、解説は終了です。ありがとうございました。
おわりに
ご覧いただきありがとうございました。
本稿では、カレンダー作成アプリのPart2として「シフト表・当番表付きカレンダーを作成する」をお届けいたしました。
お問い合わせやご要望等ございましたら、「お問い合わせ／ご要望」またはコメントにて、ご連絡いただければ幸いでございます。
皆様の人生がより一層素晴らしいものになるよう、少しでもお役に立てれば幸いでございます。
なお、当サイトでは様々な情報を発信しております。もしよろしければ、トップページもご確認いただけると幸いでございます。
関連記事
本稿と関連の深い記事です。もしよろしければ、合わせてご活用ください。
- 【簡単エクセル/Excel VBA マクロ】Excel VBA マクロの全体像 | みんなの実用学 (jitsuyogaku.com)
- 【簡単エクセル/Excel VBA マクロ】通常使用編目次 | みんなの実用学 (jitsuyogaku.com)
- 【簡単エクセル/Excel VBA マクロ】ワンポイントテクニック編目次 | みんなの実用学 (jitsuyogaku.com)
- 【簡単エクセル/Excel VBA マクロ】アプリ事例編目次 | みんなの実用学 (jitsuyogaku.com)
VBAプログラミングスキルアップのための参考情報
ここでは参考図書を紹介いたしますが、これらに限らず自分に合うものを選ぶことが重要だと考えております。皆様の、より一層のご成功を心よりお祈りしております。
VBAプログラミングのスキルアップ
学習用としてもハンドブックとしても役立つ便利な書籍がこちらです。価格はやや高めですが、その内容は非常に充実しています。相応のスキルを身に付けるためには、こうしたしっかりとした書籍を一冊持っておくと良いでしょう。
入門書に関しては、どの書籍も大きな違いはありません。あまり迷うことに時間をかけるよりは、手頃なものを一冊選んでみると良いでしょう。VBAの入門書は数多く出版されていますので、興味がある方はぜひチェックしてみてください。
甲乙つけがたい場合、私はインプレス社の「いちばんやさしい」シリーズを選ぶことが多いです。
＼チェックしてみよう／
＼チェックしてみよう／
＼チェックしてみよう／
VBAのプログラミング能力を客観的に証明したい場合には「VBAエキスパート試験」があります。この試験はVBAの知識を公式に認定するものです。VBAの総合的な能力獲得を目指す方に適しています。以下の公式テキストが販売されております。
プログラミングの一般教養
「独学プログラマー」というプログラミングの魅力を解説した書籍があります。これはVBAではなくPythonを題材としていますが、プログラミングの基本的な知識や思考法、仕事の進め方まで幅広く学べます。
こちらの記事でも紹介しております。もしよろしければご覧ください。
