WBS自動作成（マクロでWBS➁）
※2023/8/26にコード全文・ファイルを修正しました！ryomaさんコメントでのご質問大変ありがとうございました！！
前回は祝休日判定をVBAでしようというプログラムでした。
今回は「プロジェクト名」・「開始月」・「終了月」・「L2タスク」・「L2毎のL3タスク数」この5つの入力だけをインプットにWBSフォーマットをマクロで作成しよう！という記事です。
会社でも、WBSの更新等を手動で行っていて、めちゃくちゃ時間を取られているのを見て、スケジュール管理じゃなくてタスクにもっと時間を割くべき（当たり前）とマクロを書き、今もみんなに使っていただいてます。
ただ、既にWBSがあるところから書いていたので、今回のこの試みは、この記事のために1から考えました。（結構、時間かかりました 笑）
セルの書式設定（結合や塗りつぶし、罫線を引く等）ってマクロでどうやんんの？ってとこと、Select Case文を入れてみたのでその辺がポイントです。
1．WBSフォーマット（目指す姿）
まずは、どんなものを完成系とするかを描きました。
・書こうと思えば、L5タスクくらいまで階段状で書ける
・予定（開始・終了）は”☐”で記載
・実績（開始・終了）は”■”で記載
・終了したら行ごとグレーアウト
・祝休日はわかるように色付け
2．インプットとなる入力用シート
☐・■の実績管理系のプログラムは次回として、インプットとなるフォーマットは以下の通りです。
・プロジェクト名～L2タスクまでをB列に入力
・B列に記載したL2タスクに対していくつL3タスクの行を用意するかをD列に入力。
・WBS作成ボタンを押下
これだけで、WBSフォーマットができます。あとは、L3タスクを書いて、予定開始日・終了日を入れてってね、という感じです。
なお、ファイルのシート構成は以下の通り。
はじめに見せた、目指す完成系が「フォーマット試作版」シート。プログラムを動かすと、「入力用シート」の内容と、「祝日一覧」シートに基づき、「wbs」シートができるという仕組みです。
※祝日一覧シートって・・・という方は頭の方にリンクを貼った、前回記事をご参照ください。
3．コード全文
我流なので、美しくない記載についてはご容赦ください。
ここ、こういう風に書くと良いよ！みたいなアドバイスも大歓迎です。
（むしろ切望してます）
ryomaさんから頂いたコメントにより不具合修正
＜2023/08/26 以下不具合修正のためコード修正しました＞
・年を跨ぐWBSが作成できない
・2023/12→2024/2のように終了の月が小さいと挙動がおかしくなる
・うるう年が考慮できていない
（対応）
'20230826からのコメントあり箇所を修正しています。
月の差が13ヶ月以上となる場合には、12で割ったあまりを月名として処理するよう修正しています（targetMonth Mod 12で算出）
うるう年の定義は、4で割り切れる年（ただし、100で割り切れるが400で割り切れない場合は平年）なので、2月の場合は年数でうるう年かどうかを判定するよう処理を追加しています。
（地獄の大規模PJの際に是非・・・笑）
<2023/10/06 以下不具合修正>
2023/08/26の不具合修正の際、12の余りは0となるため日数判定が上手くいかずヘンテコな表示となる不具合を修正。（余り0の場合は12として扱うよう修正）
ファイルを直接ダウンロードされる方は、こちらで。(20231006修正事項反映済）
Sub wbsフォーマット作成()
Dim ws1, ws2, ws3 As Worksheet
Dim startMonth, endMonth, nextMonth, lastDay, checkDate, targetDate, enterDate As Date
Dim diffMonth, diffDays, i, j, k, l, sMonth, sCol, eCol, l2TaskNum, l3TaskNum, lastRow, lastCol, holidayFlug As Integer
Dim wbsTitle, l2TaskName As String
'20230826追記ここから
Dim targetMonth As Integer
'20230826追記ここまで
'Worksheetオブジェクトを設定
Set ws1 = Worksheets("入力用シート")
Set ws2 = Worksheets("祝日一覧")
'プロジェクトの開始月と終了月を取得
startMonth = ws1.Cells(3, 2).Value
endMonth = ws1.Cells(4, 2).Value
'月数を確認
diffMonth = DateDiff("m", startMonth, endMonth) + 1
'開始月から終了月までの日数を確認
'終了月の月末日を確認
nextMonth = DateAdd("m", 1, endMonth)
lastDay = DateAdd("d", -1, nextMonth)
diffDays = DateDiff("d", startMonth, lastDay) + 1
'開始月の月を取得
sMonth = Month(startMonth)
'wbsシートを作成しオブジェクト設定する’
Worksheets.Add
ActiveSheet.Name = "wbs"
Set ws3 = Worksheets("wbs")
'プロジェクト名を入力用シートから取得し記載
wbsTitle = ws1.Cells(2, 2).Value
ws3.Cells(5, 2).Value = wbsTitle
'L2タスクの数分ループ処理で行を作成し、最終行を取得する
l2TaskNum = ws1.Cells(Rows.Count, 2).End(xlUp).Row - 4
l3TaskNum = 0
For k = 1 To l2TaskNum
l2TaskName = ws1.Cells(k + 4, 2).Value
ws3.Cells(k + 5 + l3TaskNum, 3).Value = l2TaskName
l3TaskNum = ws1.Cells(k + 4, 4).Value + l3TaskNum
Next
lastRow = l2TaskNum + l3TaskNum + 5
'L2タスクの数分ループ処理で行を作成し、最終行・最終列を特定する
l2TaskNum = ws1.Cells(Rows.Count, 2).End(xlUp).Row - 4
l3TaskNum = 0
For k = 1 To l2TaskNum
l2TaskName = ws1.Cells(k + 4, 2).Value
ws3.Cells(k + 5 + l3TaskNum, 3).Value = l2TaskName
l3TaskNum = ws1.Cells(k + 4, 4).Value + l3TaskNum
Next
lastRow = l2TaskNum + l3TaskNum + 5
'lastcol = Cells(3, Columns.Count).End(xlToLeft).Column
'日付欄の開始列を設定
sCol = 23
'月から日数を確認し、月単位での最終列を確認
'２０２３０８２６修正のため以下はコメントアウト(開始月＞終了月の考慮漏れ)
'For i = sMonth To Month(endMonth)
'20230826修正ここから
For i = sMonth to sMonth + diffMonth - 1
if i > 12 Then
targetMonth = i Mod 12
'20231006修正 余りが0となった場合は12とする
If targetMonth = 0 Then
targetMonth = 12
End If
'２０２３１００６修正ここまで
Else
targetMonth = i
End If
'20230826修正ここまで
Select Case i
Case 1, 3, 5, 7, 8, 10, 12
eCol = sCol + 30
’２０２３０８２６修正ここから（閏年の考慮漏れ）
Case 4, 6, 9, 11
eCol = sCol + 29
Case 2
If Year(startMonth) Mod 4 <> 0 Then
eCol = sCol + 27
ElseIf Year(startMonth) Mod 4 = 0 _
And Year(startMonth) Mod 100 = 0 _
And Year(startMonth) Mod 400 <> 0 Then
eCol = sCol + 27
Else
eCol = sCol + 28
End If
'20230826修正ここまで
End Select
'日付欄 2行目に日数分列をマージし、センタリング、塗りつぶし、罫線設定、セルに〇月と入力
With Range(Cells(2, sCol), Cells(2, eCol))
.Merge
.HorizontalAlignment = xlCenter
.Interior.Color = RGB(255, 230, 153)
.Borders.LineStyle = xlContinuous
.Borders.Color = RGB(117, 113, 113)
’２０２３０８２６修正ここから（変数sMonthをtargetMonthに変更）
.Value = Str(targetMonth) & "月"
’２０２３０８２６修正ここまで
End With
'日付欄3行目の罫線は外枠は実線、内枠の縦線は点線にする
With Range(Cells(3, sCol), Cells(3, eCol))
.Borders(xlInsideVertical).LineStyle = xlDot
.Borders(xlInsideVertical).Color = RGB(117, 113, 113)
.BorderAround LineStyle:=xlContinuous, Color:=RGB(117, 113, 113)
.HorizontalAlignment = xlCenter
End With
enterDate = startMonth
'開始日からループ処理で日数分、日付を日のみ表記で入力していく
For j = sCol To eCol
Cells(3, j).Value = enterDate
Cells(3, j).NumberFormatLocal = "d"
enterDate = DateAdd("d", 1, enterDate)
Next
'日付欄4行目に罫線を引く（3行目同様）
With Range(Cells(4, sCol), Cells(4, eCol))
.Borders(xlInsideVertical).LineStyle = xlDot
.Borders(xlInsideVertical).Color = RGB(117, 113, 113)
.BorderAround LineStyle:=xlContinuous, Color:=RGB(117, 113, 113)
.HorizontalAlignment = xlCenter
End With
'Weekday関数で曜日を数値で取得し、CASE文で曜日を入力していく
'土日は最終行まで塗りつぶしをする
For j = sCol To eCol
Select Case Weekday(Cells(3, j).Value)
Case 1
Cells(4, j).Value = "日"
Range(Cells(4, j), Cells(lastRow, j)).Interior.Color = RGB(248, 203, 173)
Case 2
Cells(4, j).Value = "月"
Case 3
Cells(4, j).Value = "火"
Case 4
Cells(4, j).Value = "水"
Case 5
Cells(4, j).Value = "木"
Case 6
Cells(4, j).Value = "金"
Case 7
Cells(4, j).Value = "土"
Range(Cells(4, j), Cells(lastRow, j)).Interior.Color = RGB(180, 198, 231)
End Select
Next
'日付欄の5行目以降の罫線を引く（3行目・4行目と引き方は同じ）
With Range(Cells(5, 23), Cells(lastRow, Cells(3, Columns.Count).End(xlToLeft).Column))
.Borders.LineStyle = xlContinuous
.Borders.Color = RGB(117, 113, 113)
.Borders(xlInsideVertical).LineStyle = xlDot
.HorizontalAlignment = xlCenter
End With
'最後に祝日チェックを追加する(備忘)
For k = sCol To eCol
holidayFlug = 0
checkDate = ws3.Cells(3, k).Value
For l = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
targetDate = ws2.Cells(l, 1).Value
If checkDate = targetDate Then
holidayFlug = 1
End If
Next
If holidayFlug = 1 Then
ws3.Range(Cells(4, k), Cells(lastRow, k)).Interior.Color = RGB(248, 203, 173)
End If
Next
'変数sColを次の月の開始列にする
sCol = eCol + 1
'変数sMonthを翌月にする
sMonth = sMonth + 1
'変数startMonthを翌月の開始日にする
startMonth = DateAdd("m", 1, startMonth)
Next
'日付入力が全て終わったら、最終列を取得しておく
lastCol = Cells(3, Columns.Count).End(xlToLeft).Column
'A列から列幅をととのえていく
With ws3
Columns(1).ColumnWidth = 3
Range("B:Q").ColumnWidth = 2
Range("R:V").ColumnWidth = 5
Range("W:XFD").ColumnWidth = 2.13
'R列~U列の進捗欄タイトル行のセル結合・罫線・塗りつぶしと文字入力
With Range(Cells(4, 18), Cells(4, 19))
.Merge
.Interior.Color = RGB(226, 239, 218)
.HorizontalAlignment = xlCenter
.BorderAround LineStyle:=xlContinuous, Color:=RGB(117, 113, 113)
.Value = "予定"
End With
With Range(Cells(4, 20), Cells(4, 21))
.Merge
.Interior.Color = RGB(226, 239, 218)
.HorizontalAlignment = xlCenter
.BorderAround LineStyle:=xlContinuous, Color:=RGB(117, 113, 113)
.Value = "実績"
End With
'V列の罫線・塗りつぶし・文字入力
With Cells(4, 22)
.Interior.Color = RGB(226, 239, 218)
.HorizontalAlignment = xlCenter
.BorderAround LineStyle:=xlContinuous, Color:=RGB(117, 113, 113)
.Value = "進捗"
End With
End With
'タスク欄の罫線・セルの塗りつぶしを実施
Range(Cells(5, 2), Cells(lastRow, 17)).BorderAround LineStyle:=xlContinuous
Range(Cells(6, 3), Cells(lastRow, 17)).BorderAround LineStyle:=xlContinuous
Range(Cells(5, 2), Cells(5, 17)).Interior.Color = RGB(112, 173, 71)
Range(Cells(6, 2), Cells(lastRow, 2)).Interior.Color = RGB(112, 173, 71)
'6行目から最終行までタスク欄の罫線を引く、L2タスクがある場合は塗りつぶしをする
For i = 6 To lastRow
With Range(Cells(i, 3), Cells(i, 17))
.BorderAround LineStyle:=xlContinuous, Color:=RGB(117, 113, 113)
If Not Cells(i, 3).Value = "" Then
.Interior.Color = RGB(180, 198, 231)
End If
End With
Next
'進捗欄の罫線を最終行まで引く
With Range(Cells(5, 18), Cells(lastRow, 22))
.Borders.LineStyle = xlContinuous
.Borders.Color = RGB(117, 113, 113)
.HorizontalAlignment = xlCenter
End With
'5行目R~U列の文字入力
Cells(5, 18).Value = "開始"
Cells(5, 19).Value = "終了"
Cells(5, 20).Value = "開始"
Cells(5, 21).Value = "終了"
'A列に数式を挿入（インデックスとして使うもの）
For i = 6 To lastRow
Cells(i,1) = "=Row()-5"
Next
End Sub今回もファイルをダウンロードできるようにしておきますので、実際に自分でコードを書いてか、サンプルファイルをダウンロードしてF8等で動かしながら、確認していただければと思います。
また、担当列を増やす等、自己流アレンジをすると理解が深まると思うのでオススメです！
このプログラムを走らせると・・・
wbsというシート名で、以下のシートが作成されると思います。
4. コード記載前に整理した要件一覧
これもご参考ですが、僕はコードを書く前に要件を整理して、どんなプログラムを組み立てていけばいいか大体考えてから、書き始めます。書きながら、色々と修正入りますが(笑)
なお、一番難しかったのは、日付欄をどうやってマクロで書こうかというところでした。あれこれ考えた結果、Select Case文で、31日の月と30日の月別に必要となる列数を割り出すというやり方にしました。
次回は、進捗管理を行うためのプログラムについて書きたいと思います。
（WBSからすると、5/3にはアップできる予定です 笑）
5．参照サイト
今回コードを記載するにあたり、以下のサイトを参考にさせていただきました。ありがとうございます。
・罫線を引く
・塗りつぶしをする
・セルの結合
・セルの書式設定（日付）
https://valmore.work/excel-vba-case/
・Select Case文
この記事が気に入ったらサポートをしてみませんか？