Excel VBAでシフト表自動作成ツール

目的：Excelでシフト表を作成。
課題：条件通りのものを作ろうとすると時間がかかる。
解決策：VBAで条件に従い自動作成
成果物：excel-auto-shift.xlsm

※改良版を作成しています。下記リンクからどうぞ。

Excel VBAでシフト自動作成マクロを作り直しました

目的：前回作成したシフト表自動作成ツールの運用反省：抽選の偏りがあるなど細かい点で改善点が出てきた改善：一巡してからシャッフルして満遍なく配置されるようにする成果：excel-auto-shift2.xlsm前回からの反省点...

スクリーンショット
1. 操作について
VBA

スクリーンショット

シフト表を作成する上での要件をまとめます。

早出、日勤、遅出、夜勤の４種類の配置がある
１日あたり夜勤は２人、それ以外は１人ずつを最低限配置する
夜勤は1.5労働とし、基本的に２日連続で入り翌日は「明け」、その翌日は公休とする
夜勤を連続で入れない場合は翌日を年次有給休暇（年休）を半日使用する「半年」、その翌日を公休とする
６日連続で勤務となった場合、公休を２日続けて取得する
役職や個人の都合により特定の配置にしかつけない場合、「職員リスト」シートで「0」を入力する
「職員リスト」では、１ヶ月あたりの夜勤の上限回数を指定する

操作について

上部に各種ボタンを配置しています。クリックするとマクロが動きます。

まず「新規」のボタンをクリックするとアクティブのシートを複製し、シフトをまっさらな状態にします。その際、年月を入力し、日数と曜日を取得します。

配置の書かれたボタンは、選択したセルにそれぞれの配置を入力することができます。希望休など予定が決まってるのでればあらかじめ入力しておきます。

実行ボタンを押すと、空いているセルに次々と配置を入れていきます。職員はランダムに選出され、既に予定が入っているところは避けます。また、既に定員分の入力がされている配置についてはスキップします。

これで決まっている予定を守りつつ最低限の配置がされます。あとは公休の日数を調整しながら、手動で配置をしていく感じです。

シフト作成作業の６割程度が自動化されるイメージです。公休の日数調整までやろうとすればできるのですが、勤務のバランスをとるのが難しいので、仕上げは人がやると割り切った方が効率的だという判断です。

VBA

まずは最も中心となるマクロから。これは実行ボタンを押すと行われます。

Sub シフト表自動作成()
    Dim thisSheetName As String     '当月シフトのシート（マクロの実行シート）'
    Dim memSheetName As String      '常勤リストのシート'
    Dim colStart As Integer         '選択セルの列番号（この列からマクロ実行）'
    Dim colEnd As Integer           '最終日数の列番号'
    Dim memberRow As Integer        'シフトの氏名'
    Dim memLengeth As Variant       '職員数（常勤）'
    Dim allRow As Integer           '専任も含めた職員名の最終行'
    Dim nLimit As Integer           '夜勤の上限回数'
    Dim renLimit As Integer         '連勤の上限回数'
    
    colStart = 3
    startRow = 9
    Cells(startRow - 6, colStart).Select
    colEnd = Selection.End(xlToRight).Column
    Cells(startRow, 1).Select
    thisSheetName = ActiveSheet.Name
    Worksheets(thisSheetName).Copy Before:=Worksheets(thisSheetName)
    ActiveSheet.Name = thisSheetName & "作成済"
    thisSheetName = ActiveSheet.Name
    memSheetName = "職員リスト"
    
    Worksheets(memSheetName).Activate
    nLimit = Cells(7, 2).Value
    Cells(startRow, 1).Select
    memberRow = Selection.End(xlDown).Row
    memLength = memberRow - 8
    
    Dim member() As String          '職員名格納用配列'
    ReDim member(memLength) As String
    
    '職員名を格納'
    For i = 0 To memberRow - 8
        For j = 2 To 6
            member(i) = member(i) & Cells(i + 9, j).Value
        Next
    Next
    
    Worksheets(thisSheetName).Activate
    
    Dim haichiArr() As Variant      '配置名用配列'
    Dim codeArr() As Variant        '各配置のコード用配列'
    Dim clrArr() As Variant         '各配置の背景色用配列'
    Dim cntArr() As Variant         '各配置のカウント用配列'
    
    haichiArr = Array("夜勤", "早出", "遅出", "日勤")
    codeArr = Array("1*", "?1*", "??1*", "???1*")
    clrArr = Array(65280, 16776960, 52479, 15773696)
    
    '各列を走査して各配置の残りを計算'
    For i = colStart To colEnd
        cntArr = Array(2, 1, 1, 1)
        '各行を走査'
        For j = startRow To memberRow
            If Cells(j, i).Value <> "" Then
                Select Case Cells(j, i).Value
                    Case haichiArr(0)
                        cntArr(0) = cntArr(0) - 1
                    Case haichiArr(1)
                        cntArr(1) = cntArr(1) - 1
                    Case haichiArr(2)
                        cntArr(2) = cntArr(2) - 1
                    Case haichiArr(3)
                        cntArr(3) = cntArr(3) - 1
                End Select
            End If
        Next j
        
        '配置プロシージャ'
        Call 配置(member, memLength, memberRow, memSheetName, haichiArr, codeArr, clrArr, cntArr, startRow, colStart, i, colEnd, nLimit)
    Next i
    
End Sub

Sub 配置(ByRef member() As String, _
            ByVal memLength As Variant, _
            ByVal memberRow As Integer, _
            ByVal memSheetName As String, _
            ByRef haichiArr() As Variant, _
            ByRef codeArr() As Variant, _
            ByRef clrArr() As Variant, _
            ByRef cntArr() As Variant, _
            ByVal startRow As Integer, _
            ByVal colStart As Integer, _
            ByVal setCol As Integer, _
            ByVal colEnd As Integer, _
            ByVal nLimit As Integer)

    Dim setRow As Integer           '配置行'
    Dim renyaCnt As Integer         '連続夜勤カウント'
    Dim renYakin() As String        '連続夜勤候補の配列'
    ReDim renYakin(1) As String
    Dim setFlg As Boolean           '配置フラグ'
    Dim ren6Cnt As Integer          '６連勤カウント'
    Dim tmpCol As Integer           '連勤チェック用の列番号'
    
    renyaCnt = -1
    
    For i = 0 To 3
        Do While cntArr(i) > 0
            Call 抽選(member)
            For j = 0 To memLength
                If member(j) Like codeArr(i) Then
                    setRow = Right(member(j), 2)
                    If Cells(setRow, setCol).Value = "" Then
                        setFlg = True
                        '6連勤なら2連休'
                        ren6Cnt = 0
                        tmpCol = setCol - 1
                        Do While Cells(setRow, tmpCol).Value = haichiArr(0) Or _
                                Cells(setRow, tmpCol).Value = haichiArr(1) Or _
                                Cells(setRow, tmpCol).Value = haichiArr(2) Or _
                                Cells(setRow, tmpCol).Value = haichiArr(3)
                            If tmpCol > 2 Then
                                ren6Cnt = ren6Cnt + 1
                                tmpCol = tmpCol - 1
                                If ren6Cnt >= 6 Then
                                    Cells(setRow, setCol).Value = "公休"
                                    For k = setCol + 1 To colEnd
                                        If Cells(setRow, k).Value = "" Then
                                            Cells(setRow, k).Value = "公休"
                                            Exit For
                                        End If
                                    Next k
                                    setFlg = False
                                    Exit Do
                                End If
                            Else
                                Exit Do
                            End If
                        Loop
                            
                        '夜勤の場合'
                        If i = 0 And setFlg = True Then
                            '夜勤上限回数'
                            If Cells(setRow, 37).Value >= nLimit Then
                                setFlg = False
                            End If
                                
                            '翌日・翌々日に予定入りの場合は夜勤を設定しない'
                            If Cells(setRow, setCol + 1).Value <> "" Or Cells(setRow, setCol + 2).Value <> "" Then
                                setFlg = False
                            End If
                                
                            'セット可能なら連続夜勤の候補に入れる'
                            If setCol <> colEnd And setFlg = True Then
                                renyaCnt = renyaCnt + 1
                                renYakin(renyaCnt) = member(j)
                            End If
                        End If
                        
                        '条件を満たしていれば配置'
                        If setFlg = True Then
                            Cells(setRow, setCol).Value = haichiArr(i)
                            Cells(setRow, setCol).Interior.Color = clrArr(i)
                            Exit For
                        End If
                    End If
                End If
            Next
            cntArr(i) = cntArr(i) - 1
        Loop
    Next
    
    '連続夜勤処理'
    If renyaCnt >= 0 And setCol <> colEnd Then
        cntArr(0) = 2
        
        For i = 9 To allRow
            If Cells(i, setCol + 1).Value = haichiArr(0) Then
                cntArr(0) = cntArr(0) - 1
            End If
        Next
                
        For i = 0 To 2
            Do While cntArr(i) > 0
                Call 抽選(renYakin)
                For j = 0 To renyaCnt
                    If renYakin(j) Like codeArr(i) Then
                        setRow = Right(renYakin(j), 2)
                        If Cells(setRow, setCol + 3).Value = "" Then
                            setFlg = True
                                                            
                            If setFlg = True Then
                                Cells(setRow, setCol + 1).Value = haichiArr(i)
                                Cells(setRow, setCol + 1).Interior.Color = clrArr(i)
                                If setCol < colEnd - 1 Then
                                    Cells(setRow, setCol + 2).Value = "明け"
                                End If
                                If setCol < colEnd - 2 Then
                                    Cells(setRow, setCol + 3).Value = "公休"
                                End If
                                Exit For
                            End If
                        End If
                    End If
                Next
                cntArr(i) = cntArr(i) - 1
            Loop
        Next
        
        '連続でない場合の夜勤後の処理'
        For i = 0 To 1
            If renYakin(i) <> "" Then
                setRow = Right(renYakin(i), 2)
                If Cells(setRow, setCol + 1).Value = "" Then
                    Cells(setRow, setCol + 1).Value = "半年"
                    If setCol < colEnd - 1 Then
                        Cells(setRow, setCol + 2).Value = "公休"
                    End If
                End If
            End If
        Next
    End If
End Sub

Sub 抽選(ByRef member() As String)
    For i = 0 To UBound(member)
        Randomize
        rn = Int(UBound(member) * Rnd)
        tmp = member(i)
        member(i) = member(rn)
        member(rn) = tmp
    Next
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

Sub シフト表自動作成()

Dim thisSheetName As String '当月シフトのシート（マクロの実行シート）'

Dim memSheetName As String '常勤リストのシート'

Dim colStart As Integer '選択セルの列番号（この列からマクロ実行）'

Dim colEnd As Integer '最終日数の列番号'

Dim memberRow As Integer 'シフトの氏名'

Dim memLengeth As Variant '職員数（常勤）'

Dim allRow As Integer '専任も含めた職員名の最終行'

Dim nLimit As Integer '夜勤の上限回数'

Dim renLimit As Integer '連勤の上限回数'

colStart = 3

startRow = 9

Cells(startRow - 6, colStart).Select

colEnd = Selection.End(xlToRight).Column

Cells(startRow, 1).Select

thisSheetName = ActiveSheet.Name

Worksheets(thisSheetName).Copy Before:=Worksheets(thisSheetName)

ActiveSheet.Name = thisSheetName & "作成済"

thisSheetName = ActiveSheet.Name

memSheetName = "職員リスト"

Worksheets(memSheetName).Activate

nLimit = Cells(7, 2).Value

Cells(startRow, 1).Select

memberRow = Selection.End(xlDown).Row

memLength = memberRow - 8

Dim member() As String '職員名格納用配列'

ReDim member(memLength) As String

'職員名を格納'

For i = 0 To memberRow - 8

For j = 2 To 6

member(i) = member(i) & Cells(i + 9, j).Value

Worksheets(thisSheetName).Activate

Dim haichiArr() As Variant '配置名用配列'

Dim codeArr() As Variant '各配置のコード用配列'

Dim clrArr() As Variant '各配置の背景色用配列'

Dim cntArr() As Variant '各配置のカウント用配列'

haichiArr = Array("夜勤", "早出", "遅出", "日勤")

codeArr = Array("1*", "?1*", "??1*", "???1*")

clrArr = Array(65280, 16776960, 52479, 15773696)

'各列を走査して各配置の残りを計算'

For i = colStart To colEnd

cntArr = Array(2, 1, 1, 1)

'各行を走査'

For j = startRow To memberRow

If Cells(j, i).Value <> "" Then

Select Case Cells(j, i).Value

Case haichiArr(0)

cntArr(0) = cntArr(0) - 1

Case haichiArr(1)

cntArr(1) = cntArr(1) - 1

Case haichiArr(2)

cntArr(2) = cntArr(2) - 1

Case haichiArr(3)

cntArr(3) = cntArr(3) - 1

End Select

End If

Next j

'配置プロシージャ'

Call 配置(member, memLength, memberRow, memSheetName, haichiArr, codeArr, clrArr, cntArr, startRow, colStart, i, colEnd, nLimit)

Next i

End Sub

Sub 配置(ByRef member() As String, _

ByVal memLength As Variant, _

ByVal memberRow As Integer, _

ByVal memSheetName As String, _

ByRef haichiArr() As Variant, _

ByRef codeArr() As Variant, _

ByRef clrArr() As Variant, _

ByRef cntArr() As Variant, _

ByVal startRow As Integer, _

ByVal colStart As Integer, _

ByVal setCol As Integer, _

ByVal colEnd As Integer, _

ByVal nLimit As Integer)

Dim setRow As Integer '配置行'

Dim renyaCnt As Integer '連続夜勤カウント'

Dim renYakin() As String '連続夜勤候補の配列'

ReDim renYakin(1) As String

Dim setFlg As Boolean '配置フラグ'

Dim ren6Cnt As Integer '６連勤カウント'

Dim tmpCol As Integer '連勤チェック用の列番号'

renyaCnt = -1

For i = 0 To 3

Do While cntArr(i) > 0

Call 抽選(member)

For j = 0 To memLength

If member(j) Like codeArr(i) Then

setRow = Right(member(j), 2)

If Cells(setRow, setCol).Value = "" Then

setFlg = True

'6連勤なら2連休'

ren6Cnt = 0

tmpCol = setCol - 1

Do While Cells(setRow, tmpCol).Value = haichiArr(0) Or _

Cells(setRow, tmpCol).Value = haichiArr(1) Or _

Cells(setRow, tmpCol).Value = haichiArr(2) Or _

Cells(setRow, tmpCol).Value = haichiArr(3)

If tmpCol > 2 Then

ren6Cnt = ren6Cnt + 1

tmpCol = tmpCol - 1

If ren6Cnt >= 6 Then

Cells(setRow, setCol).Value = "公休"

For k = setCol + 1 To colEnd

If Cells(setRow, k).Value = "" Then

Cells(setRow, k).Value = "公休"

Exit For

End If

Next k

setFlg = False

Exit Do

End If

Else

Exit Do

End If

Loop

'夜勤の場合'

If i = 0 And setFlg = True Then

'夜勤上限回数'

If Cells(setRow, 37).Value >= nLimit Then

setFlg = False

End If

'翌日・翌々日に予定入りの場合は夜勤を設定しない'

If Cells(setRow, setCol + 1).Value <> "" Or Cells(setRow, setCol + 2).Value <> "" Then

setFlg = False

End If

'セット可能なら連続夜勤の候補に入れる'

If setCol <> colEnd And setFlg = True Then

renyaCnt = renyaCnt + 1

renYakin(renyaCnt) = member(j)

End If

'条件を満たしていれば配置'

If setFlg = True Then

Cells(setRow, setCol).Value = haichiArr(i)

Cells(setRow, setCol).Interior.Color = clrArr(i)

Exit For

End If

cntArr(i) = cntArr(i) - 1

Loop

'連続夜勤処理'

If renyaCnt >= 0 And setCol <> colEnd Then

cntArr(0) = 2

For i = 9 To allRow

If Cells(i, setCol + 1).Value = haichiArr(0) Then

cntArr(0) = cntArr(0) - 1

End If

For i = 0 To 2

Do While cntArr(i) > 0

Call 抽選(renYakin)

For j = 0 To renyaCnt

If renYakin(j) Like codeArr(i) Then

setRow = Right(renYakin(j), 2)

If Cells(setRow, setCol + 3).Value = "" Then

setFlg = True

If setFlg = True Then

Cells(setRow, setCol + 1).Value = haichiArr(i)

Cells(setRow, setCol + 1).Interior.Color = clrArr(i)

If setCol < colEnd - 1 Then

Cells(setRow, setCol + 2).Value = "明け"

End If

If setCol < colEnd - 2 Then

Cells(setRow, setCol + 3).Value = "公休"

End If

Exit For

End If

cntArr(i) = cntArr(i) - 1

Loop

'連続でない場合の夜勤後の処理'

For i = 0 To 1

If renYakin(i) <> "" Then

setRow = Right(renYakin(i), 2)

If Cells(setRow, setCol + 1).Value = "" Then

Cells(setRow, setCol + 1).Value = "半年"

If setCol < colEnd - 1 Then

Cells(setRow, setCol + 2).Value = "公休"

End If

End Sub

Sub 抽選(ByRef member() As String)

For i = 0 To UBound(member)

Randomize

rn = Int(UBound(member) * Rnd)

tmp = member(i)

member(i) = member(rn)

member(rn) = tmp

End Sub

主にやっていることは、日数と人数を調べた上でひたすらループさせて、条件に合っていればシフトを配置するというのを繰り返しているだけです。

このマクロの肝は配列と抽選。職員リストで配置可能は1、配置不可能は0という入力をするというルールですが、各列の値をくっつけて配列に格納させています。

例えば１人目の佐藤さんの場合は「011109」で、１桁目が0なので夜勤不可、それ以外は配置可能、末尾２桁は行番号を示すのでこれは佐藤さんの情報であるということを意味します。

これを職員の人数分配列に格納させ、Randomizeで配列内をシャッフルして抽選します。この抽選のコードはVBAで配列をシャッフルする（要素をランダムに並べ替える）を参考にしました。

新規作成

新規シートを作成するマクロです。新規ボタンから実行します。

Sub 新規()
    Dim thisYear As Variant         '年'
    Dim thisMonth As Variant        '月'
    Dim thisSheetName As String     '元のシート名'
    Dim rowEnd As Integer           '最終行'
    Dim colEnd As Integer           '最終列'
    Dim fstWeekday As Variant       '１日の曜日'
    
    '年月入力'
    thisYear = Application.InputBox("西暦を半角4桁の数字で入力してください。")
    
    If thisYear = False Then
        Exit Sub
    End If
    
    If Len(thisYear) <> 4 Then
        MsgBox ("西暦は4桁で入力してください。" _
            & vbCrLf & "処理を中止します。")
        Exit Sub
    End If
    
    thisMonth = Application.InputBox("月を半角で入力してください。（1～12）")
    
    If thisMonth = False Then
        Exit Sub
    End If
    
    If thisMonth < 1 Or thisMonth > 12 Then
        MsgBox ("月は1～12で入力してください。" _
            & vbCrLf & "処理を中止します。")
        Exit Sub
    End If
    
    'シート処理'
    thisSheetName = ActiveSheet.Name
    Worksheets(thisSheetName).Copy Before:=Worksheets(thisSheetName)
    ActiveSheet.Name = thisYear & "." & thisMonth
    Cells(2, 17).Value = thisMonth & "月勤務表"
    
    '最終行取得'
    Cells(9, 1).Select
    rowEnd = Selection.End(xlDown).Row
    
    '内容をリセット'
    Range(Cells(3, 3), Cells(rowEnd, 33)).ClearContents
    Range(Cells(9, 3), Cells(rowEnd, 33)).Interior.ColorIndex = xlNone
    Range(Cells(3, 1), Cells(rowEnd, 33)).Borders.LineStyle = xlLineStyleNone
    
    '月から最終列を取得'
    Select Case thisMonth
        Case 4, 6, 9, 11
            colEnd = 32
        Case 2
            If Not thisYear Mod 400 = 0 Then
                If thisYear Mod 100 = 0 Then
                    colEnd = 30
                ElseIf thisYear Mod 4 = 0 Then
                    colEnd = 31
                Else
                    colEnd = 30
                End If
            End If
        Case Else
            colEnd = 33
    End Select
    
    '1日の曜日を取得'
    fstWeekday = Weekday(thisYear & "/" & thisMonth & "/1")
    
    Select Case fstWeekday
        Case 1
            fstWeekday = "日"
        Case 2
            fstWeekday = "月"
        Case 3
            fstWeekday = "火"
        Case 4
            fstWeekday = "水"
        Case 5
            fstWeekday = "木"
        Case 6
            fstWeekday = "金"
        Case 7
            fstWeekday = "土"
    End Select
    
    '日付を入力しオートフィル'
    Cells(3, 3).Value = "1"
    Cells(3, 3).AutoFill Destination:=Range(Cells(3, 3), Cells(3, colEnd)), Type:=xlFillSeries
    '曜日を入力しオートフィル'
    Cells(4, 3).Value = fstWeekday
    Cells(4, 3).AutoFill Destination:=Range(Cells(4, 3), Cells(4, colEnd)), Type:=xlFillDays
    '罫線を引く'
    Range(Cells(3, 1), Cells(rowEnd, colEnd)).Borders.LineStyle = xlContinuous
End Sub

Sub 新規()

Dim thisYear As Variant '年'

Dim thisMonth As Variant '月'

Dim thisSheetName As String '元のシート名'

Dim rowEnd As Integer '最終行'

Dim colEnd As Integer '最終列'

Dim fstWeekday As Variant '１日の曜日'

'年月入力'

thisYear = Application.InputBox("西暦を半角4桁の数字で入力してください。")

If thisYear = False Then

Exit Sub

End If

If Len(thisYear) <> 4 Then

MsgBox ("西暦は4桁で入力してください。" _

& vbCrLf & "処理を中止します。")

Exit Sub

End If

thisMonth = Application.InputBox("月を半角で入力してください。（1～12）")

If thisMonth = False Then

Exit Sub

End If

If thisMonth < 1 Or thisMonth > 12 Then

MsgBox ("月は1～12で入力してください。" _

& vbCrLf & "処理を中止します。")

Exit Sub

End If

'シート処理'

thisSheetName = ActiveSheet.Name

Worksheets(thisSheetName).Copy Before:=Worksheets(thisSheetName)

ActiveSheet.Name = thisYear & "." & thisMonth

Cells(2, 17).Value = thisMonth & "月勤務表"

'最終行取得'

Cells(9, 1).Select

rowEnd = Selection.End(xlDown).Row

'内容をリセット'

Range(Cells(3, 3), Cells(rowEnd, 33)).ClearContents

Range(Cells(9, 3), Cells(rowEnd, 33)).Interior.ColorIndex = xlNone

Range(Cells(3, 1), Cells(rowEnd, 33)).Borders.LineStyle = xlLineStyleNone

'月から最終列を取得'

Select Case thisMonth

Case 4, 6, 9, 11

colEnd = 32

Case 2

If Not thisYear Mod 400 = 0 Then

If thisYear Mod 100 = 0 Then

colEnd = 30

ElseIf thisYear Mod 4 = 0 Then

colEnd = 31

Else

colEnd = 30

End If

Case Else

colEnd = 33

End Select

'1日の曜日を取得'

fstWeekday = Weekday(thisYear & "/" & thisMonth & "/1")

Select Case fstWeekday

Case 1

fstWeekday = "日"

Case 2

fstWeekday = "月"

Case 3

fstWeekday = "火"

Case 4

fstWeekday = "水"

Case 5

fstWeekday = "木"

Case 6

fstWeekday = "金"

Case 7

fstWeekday = "土"

End Select

'日付を入力しオートフィル'

Cells(3, 3).Value = "1"

Cells(3, 3).AutoFill Destination:=Range(Cells(3, 3), Cells(3, colEnd)), Type:=xlFillSeries

'曜日を入力しオートフィル'

Cells(4, 3).Value = fstWeekday

Cells(4, 3).AutoFill Destination:=Range(Cells(4, 3), Cells(4, colEnd)), Type:=xlFillDays

'罫線を引く'

Range(Cells(3, 1), Cells(rowEnd, colEnd)).Borders.LineStyle = xlContinuous

End Sub

特に言うことはありません。閏年の判定については前に記事にしましたので説明は不要です。

強いて言うなら曜日は初日の分を取得し、あとはオートフィルで仕上げていること。それだけ。