目的
毎年、弊社は年度の初めに年間の勤務スケジュールを提出しないといけないのですが、年間のスケジュールを作成するのに多くの時間がかかり、またミスも多くて修正にも時間がかかるという問題がありました。そこで、これらの問題を解決するために、ChatGPTさんの協力を得て、スケジュールを自動的に作成するExcelマクロを作成しました。
概要（作成条件）
このマクロは、毎年のスケジュールを自動で作成し、以下のような機能を備えています：
毎月のスケジュールを自動生成：各月の開始日（21日）から翌月の終了日（20日）までのスケジュールを生成します。
土日を自動判定：土日は自動的に「休日」としてマークされます。
有給休暇の自動配置：年間で最大10日（最低7日）の有給休暇をランダムに配置します。
連続休日の自動配置：お盆、年末年始、5月に5日間の連続休日を配置します。さらに、ランダムな日に追加で連続休日を配置し、年間で合計20日になるようにします。
年間の総勤務時間を計算：各月の総勤務時間と年間の総勤務時間を計算します。
サマリシートの作成：各月の休日数、有給数、勤務時間、連続休日数をまとめたサマリシートを作成します。
ChatGPTさんを使って得られたメリット
今回、ChatGPTさんを活用することで以下のようなメリットを得ることができました。
工数の削減
手動でスケジュールを作成する場合、ミスを防ぐための確認作業や修正作業が多く発生し、膨大な時間がかかっていました。
ChatGPTさんの助けを借りることで、短時間で正確なマクロを作成することができ、作業時間を大幅に削減できました。
時間の有効活用
自動化により、スケジュール作成に費やしていた時間を他の重要な業務や家族サービス（自宅の大掃除と大洗濯大会）に充てることができました。
安心と信頼
ChatGPTさんによるサポートで、スケジュール作成のミスを大幅に減らし、信頼性の高いスケジュールを迅速に作成することができました。
ChatGPTさんにコード作成を依頼するコツ
ChatGPTさんにご依頼する際には、以下の点に注意するとより効果的です：
具体的なエラーの指摘
デバッグ中に見つかったエラーは、具体的に指摘するようにしましょう。例えば、「日付配列の初期化で型の不一致エラーが発生しています」といった具体的な説明が有効です。
修正の指示を明確に
「このエラーを修正してほしい」といった具体的な指示を与えましょう。また、「この部分を修正することで他の部分も影響を受ける可能性があるので、全体を確認して修正してください」といった指示を追加すると、エラーの再発を防ぐことができます。
全体の確認を促す：
修正が一部分に留まらず、全体のコードに影響を与える可能性があることを意識して、ChatGPTさんに全体を確認させるように指示します。これにより、修正によって生じる新たなエラーを未然に防ぐことができます。
結論
このマクロを使用することで、毎年のスケジュール作成の手間とミスを大幅に削減することができました。ChatGPTさんの協力を得ることで、短期間で効率的なマクロを作成することができ、大変助かりました。皆さんもぜひ試してみてください。
画面
マクロを起動するスイッチです。初期状態ではこれ一つのみで、
押せば勝手にその年のスケジュールを作成します。
※今後、使うならいつに長期休暇/有給を取りたいから、ここでだとか、
この月は休み多めだとかのパラメータをセルに入れて、それを元に
作成するように出来たらいいなと。
年間の月ごとの総勤務時間、休みの日数などのサマリ画面
長期休暇がない通常月の感じ
長期休暇がある月※年末（31日、30日は勤務、元日からは長期休暇）
コード
VBAコード
Sub CreateJapaneseWorkSchedule()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ws As Worksheet
Dim summarySheet As Worksheet
Dim monthNames As Variant
Dim dayNames As Variant
Dim i As Integer, j As Integer, k As Integer
Dim startDate As Date, endDate As Date
Dim totalHours As Double
Dim daysOffCount As Integer
Dim paidLeaveCount As Integer
Dim consecutiveDaysOffCount As Integer
Dim fiscalYear As Integer
Dim existingSheet As Worksheet
Dim summaryPosition As Integer
Dim annualTotalHours As Double
Dim paidLeaveDates() As Date
Dim consecutiveLeaveDates() As Date
Dim rndMonth As Integer, rndDay As Integer
Dim rndDate As Date
Dim totalPaidLeaveDays As Integer
Dim totalConsecutiveLeaveDays As Integer
Dim data() As Variant
Dim currentDate As Date
Dim rowIndex As Integer
' Initialize arrays
monthNames = Array("7月", "8月", "9月", "10月", "11月", "12月", "1月", "2月", "3月", "4月", "5月", "6月")
dayNames = Array("日曜日", "月曜日", "火曜日", "水曜日", "木曜日", "金曜日", "土曜日")
fiscalYear = 2024
' Initialize paid leave dates
ReDim paidLeaveDates(6)
paidLeaveDates(0) = DateSerial(fiscalYear, 6, 24)
paidLeaveDates(1) = DateSerial(fiscalYear, 7, 15)
paidLeaveDates(2) = DateSerial(fiscalYear, 9, 9)
paidLeaveDates(3) = DateSerial(fiscalYear, 10, 20)
paidLeaveDates(4) = DateSerial(fiscalYear, 11, 13)
paidLeaveDates(5) = DateSerial(fiscalYear + 1, 1, 5)
paidLeaveDates(6) = DateSerial(fiscalYear + 1, 3, 4)
' Initialize consecutive leave dates
ReDim consecutiveLeaveDates(2)
consecutiveLeaveDates(0) = DateSerial(fiscalYear, 8, 12)
consecutiveLeaveDates(1) = DateSerial(fiscalYear + 1, 1, 1)
consecutiveLeaveDates(2) = DateSerial(fiscalYear + 1, 5, 1)
' Add 5 random consecutive leave days to fill up to 20 days
totalConsecutiveLeaveDays = 15
Do While totalConsecutiveLeaveDays < 20
rndMonth = Int((12) * Rnd) + 6
rndDay = Int((28) * Rnd) + 1
rndDate = DateSerial(fiscalYear, rndMonth, rndDay)
If rndDate > DateSerial(fiscalYear, 6, 20) And rndDate < DateSerial(fiscalYear + 1, 6, 21) Then
ReDim Preserve consecutiveLeaveDates(UBound(consecutiveLeaveDates) + 1)
consecutiveLeaveDates(UBound(consecutiveLeaveDates)) = rndDate
totalConsecutiveLeaveDays = totalConsecutiveLeaveDays + 5
End If
Loop
' Add up to 3 more paid leave days to make a total of 10
totalPaidLeaveDays = 7
Do While totalPaidLeaveDays < 10
rndMonth = Int((12) * Rnd) + 6
rndDay = Int((28) * Rnd) + 1
rndDate = DateSerial(fiscalYear, rndMonth, rndDay)
If rndDate > DateSerial(fiscalYear, 6, 20) And rndDate < DateSerial(fiscalYear + 1, 6, 21) Then
ReDim Preserve paidLeaveDates(UBound(paidLeaveDates) + 1)
paidLeaveDates(UBound(paidLeaveDates)) = rndDate
totalPaidLeaveDays = totalPaidLeaveDays + 1
End If
Loop
' Create or clear Summary Sheet
On Error Resume Next
Set summarySheet = ThisWorkbook.Sheets("Summary")
On Error GoTo 0
If summarySheet Is Nothing Then
Set summarySheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(1))
summarySheet.Name = "Summary"
Else
summarySheet.Cells.Clear
End If
' Set up summary sheet headers
summarySheet.Cells(1, 1).Value = "月度"
summarySheet.Cells(1, 2).Value = "休日数"
summarySheet.Cells(1, 3).Value = "有給数"
summarySheet.Cells(1, 4).Value = "勤務時間"
summarySheet.Cells(1, 5).Value = "連続休日数"
annualTotalHours = 0
For i = 0 To 11
' Calculate the start and end dates for each month period
startDate = DateSerial(fiscalYear, 6 + i, 21)
endDate = DateSerial(fiscalYear, 7 + i, 20)
' Adjust for the year change
If Month(startDate) > 12 Then
startDate = DateSerial(fiscalYear + 1, Month(startDate) - 12, 21)
End If
If Month(endDate) > 12 Then
endDate = DateSerial(fiscalYear + 1, Month(endDate) - 12, 20)
End If
' Create or clear existing worksheet for each month
On Error Resume Next
Set existingSheet = ThisWorkbook.Sheets(fiscalYear & "年度" & monthNames(i) & "度")
On Error GoTo 0
If Not existingSheet Is Nothing Then
existingSheet.Cells.Clear
Set ws = existingSheet
Else
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = fiscalYear & "年度" & monthNames(i) & "度"
End If
' Initialize data array
ReDim data(DateDiff("d", startDate, endDate), 7)
totalHours = 0
daysOffCount = 0
paidLeaveCount = 0
consecutiveDaysOffCount = 0
' Determine maximum monthly hours
Select Case Month(endDate)
Case 1, 3, 5, 7, 8, 10, 12
maxMonthlyHours = 177
Case 4, 6, 9, 11
maxMonthlyHours = 171
Case 2
maxMonthlyHours = 160
End Select
' Fill in the dates and days of the week
For j = 0 To DateDiff("d", startDate, endDate)
currentDate = startDate + j
rowIndex = j + 3
data(j, 0) = Month(currentDate)
data(j, 1) = Day(currentDate)
data(j, 2) = dayNames(Weekday(currentDate, vbSunday) - 1)
' Initialize attributes
data(j, 7) = ""
' Check if the day is a weekend
If data(j, 2) = "土曜日" Or data(j, 2) = "日曜日" Then
data(j, 7) = "休日"
daysOffCount = daysOffCount + 1
End If
' Check if the day is a paid leave
For k = LBound(paidLeaveDates) To UBound(paidLeaveDates)
If currentDate = paidLeaveDates(k) Then
data(j, 7) = "有給"
paidLeaveCount = paidLeaveCount + 1
Exit For
End If
Next k
' Check if the day is a consecutive leave
For k = LBound(consecutiveLeaveDates) To UBound(consecutiveLeaveDates)
If currentDate >= consecutiveLeaveDates(k) And currentDate < consecutiveLeaveDates(k) + 5 Then
data(j, 7) = "連続休日"
consecutiveDaysOffCount = consecutiveDaysOffCount + 1
Exit For
End If
Next k
' Check if the day is a working day
If data(j, 7) = "" Then
data(j, 3) = "9:00"
data(j, 4) = "19:00"
data(j, 5) = "12:00 - 13:00"
data(j, 6) = 8 ' 9:00 to 19:00 with 1 hour break
totalHours = totalHours + 8
Else
data(j, 3) = ""
data(j, 4) = ""
data(j, 5) = ""
data(j, 6) = 0
End If
Next j
' Write data to worksheet
ws.Cells(3, 1).Resize(UBound(data, 1) + 1, UBound(data, 2) + 1).Value = data
' Autofit columns for better visibility
ws.Columns("A:H").AutoFit
' Set total monthly hours
ws.Cells(1, 2).Value = totalHours & " 時間"
' Add to summary sheet
summarySheet.Cells(i + 2, 1).Value = ws.Name
summarySheet.Cells(i + 2, 2).Value = daysOffCount
summarySheet.Cells(i + 2, 3).Value = paidLeaveCount
summarySheet.Cells(i + 2, 4).Value = totalHours
summarySheet.Cells(i + 2, 5).Value = consecutiveDaysOffCount
' Update annual total hours
annualTotalHours = annualTotalHours + totalHours
Next i
' Add annual total hours to summary sheet
summarySheet.Cells(15, 1).Value = "年間合計勤務時間"
summarySheet.Cells(15, 2).Value = annualTotalHours & " 時間"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "勤務表が正常に作成されました！"
End Sub