【実務・中級編】【実務中級】「期限(Deadline)」設定と「終了日固定」制約の併用による、進捗遅延リスクの早期アラートシステム – Project VBA解析バイブル

スポンサーリンク
スポンサーリンク

【極限の知見】MS Project VBAで構築する「制約」と「期限」の二層防御:遅延を予兆する早期アラート設計

プロジェクト管理の現場において、多くの「ツール作成者」が陥る致命的な罠がある。それは、「スケジュールを固定すること」を「管理すること」だと勘違いしている点だ。

「このタスクは絶対に○日までに終わらせなければならない」という強い意志を、MS Projectの「制約条件(Constraint)」、例えば「完了日は〜でなければならない(Must Finish On)」として入力してしまう。これは一見、管理が徹底されているように見えるが、エンジニアリングの視点から見れば、スケジュールの動的計算能力(Scheduling Engine)に対する自爆行為に等しい。

本記事では、プロジェクトの柔軟性を保ちつつ、遅延リスクを「予兆」の段階で検知する、極めて堅牢な「期限(Deadline)×制約(Constraint)」の二層防御システムについて、その設計思想と実装方法を伝授する。

1. 設計思想:なぜ「制約」を使いすぎてはいけないのか

MS Projectの真価は、先行・後続関係に基づいた「動的な再計算」にある。

制約条件(Constraint)の副作用

「完了日は〜でなければならない」という制約を課すと、そのタスクの「スラック(余裕時間)」は強制的にゼロ、あるいは計算不能な状態に陥る。制約は、スケジュールの計算エンジンに対して「この日付以外は無視しろ」という命令を下す。これにより、クリティカルパスの計算が歪み、プロジェクト全体の遅延がどこに波及するのかという「情報の透明性」が失われるのだ。

期限(Deadline)という「センサー」

一方で、MS Projectには「期限(Deadline)」というプロパティが存在する。これは計算エンジンを縛るものではない。あくまで「この日付を超えたら警告を出せ」という、非破壊的な閾値(Threshold)として機能する。

我々が目指すべき設計はこうだ:
1. 制約(Constraint)は、可能な限り「なし(As Soon As Possible)」に保ち、エンジンの自由度を最大化する。
2. 期限(Deadline)に、実務上のデッドラインを設定する。
3. VBAによって、「計算上の終了日」と「期限」の乖離を監視し、リスクを可視化する。

2. リスク検知アルゴリズムの定義

単に「終了日 > 期限」を判定するだけでは、中級者のコードだ。プロフェッショナルは、「スラック(Total Slack)」と「期限」の相関を見る。

タスクが以下の状態にあるとき、システムはアラートを上げるべきである。

  • レベル1(注意): `Finish` 日が `Deadline` に接近している。
  • レベル2(警告): `Finish + Total Slack`(理論上の最遅終了日)が `Deadline` を突き抜ける。
  • レベル3(致命的): `Finish` が既に `Deadline` を超過している。

3. プロダクション・コードの実装

以下に、実務でそのまま利用可能な、堅牢な設計思想に基づいたVBAコードを示す。このコードは、単なるループ処理ではなく、エラーハンドリングとオブジェクトのライフサイクルを考慮した設計にしている。

Option Explicit

' ======================================================================================
' Module: RiskManagementEngine
' Description: スケジュールの制約と期限の乖離を監視し、遅延リスクを特定する
' Author: Chief Architect
' ======================================================================================

' リスクレベルを定義する列挙型
Public Enum RiskLevel
    rlNone = 0
    rlLow = 1       ' 注意: 期限に接近
    rlMedium = 2    ' 警告: スラックを含めると期限を超える
    rlHigh = 3      ' 致命的: 期限超過
End Enum

''' <summary>
''' プロジェクト内の全タスクをスキャンし、リスクをレポートする
''' </summary>
Public Sub ExecuteRiskAudit()
    Dim t As Task
    Dim proj As Project
    Dim reportSheet As Worksheet
    Dim rowIdx As Long
    
    Set proj = ActiveProject
    
    ' 高速化のための設定
    On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
    
    ' 結果出力用のシート準備(Excel連携を想定した設計)
    ' ここではMS Project内の新しいシート、あるいはログ出力のロジックを想定
    Set reportSheet = PrepareReportSheet()
    rowIdx = 2
    
    ' ヘッダー書き込み
    With reportSheet
        .Cells(1, 1).Value = "Task Name"
        .Cells(1, 2).Value = "Finish Date"
        .Cells(1, 3).Value = "Deadline"
        .Cells(1, 4).Value = "Slack (Days)"
        .Cells(1, 5).Value = "Risk Level"
        .Cells(1, 6).Value = "Status Message"
    End With

    ' --- メイン・スキャン・エンジン ---
    For Each t In proj.Tasks
        ' 削除済みタスクや空のタスクをスキップ(オブジェクトの生存確認)
        If Not t Is Nothing Then
            If Not t.Summary Then ' サマリータスクを除外する場合(要件に応じて変更)
                
                ' 期限が設定されているタスクのみを評価対象とする
                If t.Deadline <> "N/A" And t.Deadline <> Empty Then
                    
                    Dim currentRisk As RiskLevel
                    Dim msg As String
                    
                    ' リスク判定ロジックの呼び出し
                    currentRisk = EvaluateTaskRisk(t)
                    msg = GetRiskMessage(currentRisk, t)
                    
                    ' リスクがある場合のみ、またはログとして出力
                    If currentRisk <> rlNone Then
                        WriteToReport reportSheet, rowIdx, t, currentRisk, msg
                        rowIdx = rowIdx + 1
                    End If
                End If
            End If
        End If
    Next t

    Application.ScreenUpdating = True
    MsgBox "監査が完了しました。検知されたリスク数: " & (rowIdx - 2), vbInformation
    Exit Sub

ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "致命的なエラーが発生しました: " & Err.Description, vbCritical
End Sub

''' <summary>
''' タスクの終了日、スラック、期限を比較し、リスクレベルを判定する
''' </summary>
Private Function EvaluateTaskRisk(t As Task) As RiskLevel
    Dim finishDate As Date
    Dim deadlineDate As Date
    Dim slackDays As Double
    
    finishDate = t.Finish
    deadlineDate = t.Deadline
    slackDays = t.TotalSlack / 480 ' MS Projectのスラックは「分」単位のため、日に変換(8h=480min想定)
    
    ' 1. 致命的: 既に期限を超過している
    If finishDate > deadlineDate Then
        EvaluateTaskRisk = rlHigh
    ' 2. 警告: スラックを含めて計算しても期限に間に合わない
    ElseIf (finishDate + (slackDays / 1)) > deadlineDate Then ' 簡易的な計算ロジック
        ' 厳密にはスラックの正負を考慮
        EvaluateTaskRisk = rlMedium
    ' 3. 注意: 終了日が期限の、例えば3日以内に迫っている
    ElseIf DateDiff("d", finishDate, deadlineDate) <= 3 Then
        EvaluateTaskRisk = rlLow
    Else
        EvaluateTaskRisk = rlNone
    End If
End Function

''' <summary>
''' レポート出力用のヘルパー関数
''' </summary>
Private Sub WriteToReport(ws As Worksheet, row As Long, t As Task, level As RiskLevel, msg As String)
    With ws
        .Cells(row, 1).Value = t.Name
        .Cells(row, 2).Value = t.Finish
        .Cells(row, 3).Value = t.Deadline
        .Cells(row, 4).Value = t.TotalSlack / 480
        .Cells(row, 5).Value = GetLevelString(level)
        .Cells(row, 6).Value = msg
        
        ' リスクに応じた色付け(UI/UXへの配慮)
        Select Case level
            Case rlHigh: .Rows(row).Interior.Color = RGB(255, 199, 206) ' 薄い赤
            Case rlMedium: .Rows(row).Interior.Color = RGB(255, 235, 156) ' 薄い黄
            Case rlLow: .Rows(row).Interior.Color = RGB(204, 255, 204) ' 薄い緑
        End Select
    End With
End Sub

' --- 以下、補助的なユーティリティ関数群 ---

Private Function GetLevelString(level As RiskLevel) As String
    Select Case level
        Case rlHigh: GetLevelString = "CRITICAL"
        Case rlMedium: GetLevelString = "WARNING"
        Case rlLow: GetLevelString = "CAUTION"
        Case Else: GetLevelString = "OK"
    End Select
End Function

Private Function GetRiskMessage(level As RiskLevel, t As Task) As String
    Select Case level
        Case rlHigh: GetRiskMessage = "期限を既に超過しています!即時対応が必要です。"
        Case rlMedium: GetRiskMessage = "スラックを考慮すると期限を突破します。工程の見直しを推奨。"
        Case rlLow: GetRiskMessage = "期限が間近に迫っています。"
        Case Else: GetRiskMessage = ""
    End Select
End Function

Private Function PrepareReportSheet() As Worksheet
    ' 簡易的に新しいシートを作成する実装
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ActiveProject.Application.Worksheets("Risk_Report")
    On Error GoTo 0
    
    If ws Is Nothing Then
        Set ws = ActiveProject.Application.Worksheets.Add
        ws.Name = "Risk_Report"
    Else
        ws.Cells.Clear
    End If
    Set PrepareReportSheet = ws
End Function

4. プロフェッショナルが守るべき実装上の注意点

このコードをプロダクション環境に投入する際、以下の3点に留意せよ。

① オブジェクトの生存確認(Null Check)

`For Each t In proj.Tasks` でループを回す際、ユーザーがタスクを削除したり、フィルタリングを行っていると、`t` が `Nothing` になるケースがある。必ず `If Not t Is Nothing Then` でガードを入れろ。これを怠ると、実行時エラーでツールが即死する。

② 計算精度の管理

MS Projectの `TotalSlack` プロパティは「分(Minutes)」単位で保持されている。これを「日」に変換する際、プロジェクトの標準作業時間(例:1日8時間)に基づいた定数(`480`)を用いる必要がある。ここがズレると、アラートの精度が著しく低下する。

③ スケーラビリティと外部連携

本コードでは `Worksheets.Add` を用いてMS Project内にレポートを作成しているが、大規模なプロジェクトでは、結果を Excelへ出力 するか、SQL Server等のデータベースへ書き出す 設計にすべきだ。

  • Excel連携のコツ: `Set xlApp = CreateObject(“Excel.Application”)` を使い、MS Projectとは別のプロセスとしてExcelを制御することで、メモリ管理の衝突を避け、安定性を向上させることができる。

結論

スケジュール管理とは、未来の不確実性をいかに可視化するかという戦いだ。
「制約」で無理やり未来を固定するのではなく、「期限」というセンサーを張り巡らせ、VBAというエンジンによってその乖離を監視する。この設計思想こそが、プロジェクトを破綻から救う、真に堅牢な自動化ツールの要諦である。

タイトルとURLをコピーしました