目的

毎年、弊社は年度の初めに年間の勤務スケジュールを提出しないといけないのですが、年間のスケジュールを作成するのに多くの時間がかかり、またミスも多くて修正にも時間がかかるという問題がありました。そこで、これらの問題を解決するために、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