WBS予定・完了・進捗管理プログラム(マクロでWBS➂)
前回は、入力用シートに入力された、プロジェクト名や開始・終了月、L2タスクとL3タスク数をもとにWBSシートを自動作成するプログラムをご紹介しました。
今回は、作成してL3タスク以降を追記したWBSについて、実際に進捗管理を行う際に活用できるプログラムを作成・解説します。
1．完成イメージ
以下のように、タスク（行）ごとに、予定（開始・終了）と実績（開始・終了）を日次で管理できるようにします。
2．管理方法
以下、タスク欄・進捗欄・日付欄のうち、おもに進捗欄を更新することで、極力日付欄の更新を自動化し、管理に負荷をかけないためのプログラムとなっています。
【タスク欄】
・タスク欄には、L1（プロジェクト自体）、L2以降タスクを記載
【進捗欄】
・予定欄の開始・終了列がタスクの実施予定期間をあらわしています。
・実績欄の開始・終了列が実際に着手・完了日をあらわします。
・進捗欄は、当該タスクに対していつまでの分が完了したかあらわします。
→10項目の入力を5日でやる場合、8項目までできたら4日分完了
【日付欄】
・☐が未消化、■が消化済をあらわします。
3．要件一覧
自動化したい要件を以下のとおり、整理しました。
なお、イナズマ線自動作成プログラムは次回作成します。
4．処理の流れ
今回の一番のポイントは、WBSシートが手動で更新されたことをトリガーに、予定処理・完了処理・進捗処理のプログラムを動かす部分です。
5．どうやって更新をとらえるの？
これまでのプログラムは標準モジュールを利用して書いてきましたが、今回のようにセルやワークシートに更新がされた場合に、処理を動かしたい場合、ワークシートプロシージャというものを利用します。
これまで使っていた、標準モジュールでなく、Microsoft Excel Objects内の処理を作りたいWorkSheetを選択します。（今回はSheet4(WBS）を選択。
書き出しにある、「Private Sub Worksheet_Change(ByVal Target As Range)」のように、「Sub」だけでなく頭にPrivateと付けます。
Worksheet_の後に今回は「Change」と記載していますが、シートが開いた場合や、アクティブになった場合等複数のイベントが用意されています。
（ByVal Target As Range）の部分は、変更された箇所をRange型でTargetという変数に渡しています。
プログラム中にある、例えばTarget.Rowという記載で、更新されたRangeから行数を取り出すことができます。
更新された列により、呼び出すモジュール(プログラム)を変え、Callで呼び出す際に、引数として更新された行・列を渡しているのです。
6．イベントプロシージャのコード全文
イベントプロシージャ―のコード全文は以下の通りです。
他のモジュールに記載したプログラムを呼び出す場合、Call プロシージャ名で呼び出し可能です。
また、プロシージャ名の横の括弧内に引数として、変数を渡すことができます。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim changeRow As Integer
Dim changeCol As Integer
Dim targetType As String
’更新された行・列数を取り出す
changeRow = Target.Row
changeCol = Target.Column
’更新された箇所のデータ型をtargetType変数に格納
targetType = TypeName(Cells(changeRow, changeCol).Value)
’更新されたのが7行目以降の場合のみ処理が発動
If changeRow > 6 Then
’Select Case文で更新された列により、呼び出す処理を変える
Select Case changeCol
’19列目（予定完了）の場合、予定処理を呼び出す（引数として更新行・更新列を渡す）
Case 19
’入力された値が日付型でない場合は、処理を強制終了する
If Not targetType = "Date" Then
End
End If
Call 予定処理(changeRow, changeCol)
’21列目（実績完了）の場合、完了処理を呼び出す（引数として更新行・更新列を渡す）
Case 21
Call 完了処理(changeRow, changeCol)
’22列目（進捗）の場合、進捗処理を呼び出す（引数として更新行・更新列を渡す）
Case Is = 22
If Not targetType = "Date" Then
End
End If
Call 進捗管理(changeRow, changeCol)
End Select
End If
End Sub7．予定処理プログラムのコード全文
予定処理プログラムのコード全文は以下の通りです。
引数で受け取った更新された行の、進捗欄の予定開始日と予定終了日を取得し、それが日付欄のどこの列にあたるのかを取得。（Cells.Find(値).Columnで該当列が取得できます）
入力範囲を見定めて、☐をいれてます。逆に他の列について値をクリアすることで余計な値が日付欄に残らないようにしています。
Sub 予定処理(ByVal changeRow As Integer, ByVal changeCol As Integer)
Dim startDate, endDate As Date
Dim colFrom, colTo, firstCol, lastCol As Integer
'実績終了日が入っている場合、処理を終了する
If Not Cells(changeRow, 21).Value = "" Then
MsgBox "終了済のタスクです"
End
End If
'予定開始日・終了日をそれぞれstartDate・endDate変数に格納する
startDate = Cells(changeRow, 18).Value
endDate = Cells(changeRow, 19).Value
'日付欄開始列をfirstCol変数に、最終列をlastCol変数に格納する
firstCol = 23
lastCol = Cells(3, Columns.Count).End(xlToLeft).Column
'予定開始日と合致する日付欄の列数を、colFrom変数に格納する
colFrom = Cells.Find(startDate).Column
'予定終了日と合致する日付欄の列数を、colTo変数に格納する
colTo = Cells.Find(endDate).Column
'予定開始日から終了日までのセルに、□を入力する
Range(Cells(changeRow, colFrom), Cells(changeRow, colTo)).Value = "□"
'日付欄開始列から、予定開始日前日までのセルの値をクリアする
Range(Cells(changeRow, firstCol), Cells(changeRow, colFrom - 1)).Value = ""
'予定終了日翌日から、日付欄最終列までのセルの値をクリアする
Range(Cells(changeRow, colTo + 1), Cells(changeRow, lastCol)).Value = ""
End Subプロシージャ名の横にある「ByVal changeRow as Integer」の記載は、changeRowというInteger型の変数を予め持ってございます。という意味です。
8. 完了処理プログラムのコード全文
完了処理プログラムのコード全文です。
完了時に、該当タスクが終わったことを分かりやすくするために、行自体をグレーアウトしつつ、☐→■へと更新します。
また、「あ、まだこれ終わってないじゃん！」みたいな、上席者にレビューしたら突き返されるようなパターンを想定して、終了日が外れた場合はもとに戻す処理も一応記載してます。（■はそのまま。）
Sub 完了処理(ByVal changeRow As Integer, ByVal changeCol As Integer)
Dim startDate, endDate As Date
Dim colFrom, colTo, firstCol, lastCol, i As Integer
'実績開始日と終了日を、それぞれstartDate・endDate変数に格納
startDate = Cells(changeRow, 20).Value
endDate = Cells(changeRow, 21).Value
'日付欄開始列をfirstCol変数に、最終列をlastCol変数に格納する
firstCol = 23
lastCol = Cells(3, Columns.Count).End(xlToLeft).Column
'実績終了日がブランクかどうかで条件分岐
If Not endDate = Empty Then
'実績開始日に該当する日付欄の列をcolFrom変数に格納
colFrom = Cells.Find(startDate).Column
'実績終了日に該当する日付欄の列をcolTo変数に格納
colTo = Cells.Find(endDate).Column
'一度実績開始日から終了日までの値をクリアする
Range(Cells(changeRow, firstCol), Cells(changeRow, lastCol)).Value = ""
'該当行をグレーで塗りつぶしする
Range(Cells(changeRow, 3), Cells(changeRow, lastCol)).Interior.Color = RGB(128, 128, 128)
'実績開始日から終了日までのセルに■を入力する
Range(Cells(changeRow, colFrom), Cells(changeRow, colTo)).Value = "■"
'進捗欄をクリアする
Cells(changeRow, 22).Value = ""
Else
'タスク欄の塗りつぶしをなしにする
Range(Cells(changeRow, 3), Cells(changeRow, 22)).Interior.ColorIndex = xlNone
'日付欄の開始列から終了列まで4行目の曜日欄の色を確認し、祝休日の色がついていたら、
'同じ色でセルを塗りつぶし、それ以外の場合は塗りつぶしをなしにする
For i = firstCol To lastCol
If Cells(4, i).Interior.Color = RGB(248, 203, 173) Then
Cells(changeRow, i).Interior.Color = RGB(248, 203, 173)
ElseIf Cells(4, i).Interior.Color = RGB(180, 198, 231) Then
Cells(changeRow, i).Interior.Color = RGB(180, 198, 231)
Else
Cells(changeRow, i).Interior.ColorIndex = xlNone
End If
Next
End If
End Sub9．進捗処理プログラムのコード全文
では、最後に進捗処理プログラムのコード全文です。
この処理では、着手～完了までの中間状況を、日付欄の☐を1個1個更新するのは面倒くさいので、どれくらい終わったのさ？ということを進捗欄に「〇/〇分まで終わりました！」と入力することで、日付欄に自動反映させるプログラムです。（なお、実績開始が未入力だと変な動きします・・・(笑)）
Sub 進捗管理(ByVal changeRow As Integer, ByVal changeCol As Integer)
Dim status, pStartDate, pEndDate, uStartDate, uEndDate As Date
Dim colFrom, colTo As Integer
'進捗列の値を、status変数に格納
status = Cells(changeRow, 22).Value
'予定開始日と終了日をそれぞれ変数に格納
pStartDate = Cells(changeRow, 18).Value
pEndDate = Cells(changeRow, 19).Value
'実績開始日と終了日をそれぞれ変数に格納
uStartDate = Cells(changeRow, 20).Value
uEndDate = Cells(changeRow, 21).Value
'実績終了日が入力済の場合、プログラム終了
If status = Empty Or uEndDate <> Empty Then
End
ElseIf status <> Empty And uEndDate <> Empty Then
MsgBox "タスクは既に完了済です"
End
'終了していないタスクの場合、進捗列の日付まで■を更新する
Else
colFrom = Cells.Find(uStartDate).Column
colTo = Cells.Find(status).Column
Range(Cells(changeRow, colFrom), Cells(changeRow, colTo)).Value = "■"
End If
End Subいかがでしたでしょうか？次回はいよいよ、イナズマ線に行きたいと思います。（これがとても個人的に苦労しました・・・。）
プログラムのダウンロード
10．参考になるサイト
この記事が気に入ったらサポートをしてみませんか？