【実務・中級編】「開始日固定」制約が引き起こすクリティカルパスの歪みをVBAで解析する – Project VBA解析バイブル

「開始日固定」制約が引き起こすクリティカルパスの歪みをVBAで解析する

プロジェクト管理において、スケジュール計算エンジンの挙動を完全に把握できているエンジニアはどれほどいるだろうか。特に、MS Projectや独自開発のVBA製スケジュールエンジンにおいて、「開始日固定（SNET: Start No Earlier Than 等）」の制約条件を安易に多用することが、どれほど致命的なクリティカルパスの歪みを生むか。現場のリーダーなら、その恐ろしさを痛感しているはずだ。

「とりあえずこのタスクはこの日から始めたいから」と設定された幾多の開始日固定制約は、ネットワーク図の動的なトポロジーを破壊し、フロート（余裕時間）を隠蔽し、真のクリティカルパスを見えなくする。結果として、プロジェクト終盤での「突然の炎上」を引き起こす。

今回は、この「開始日固定制約が引き起こすクリティカルパスの歪み」をVBAで定量的に検出し、リスクレポートを自動生成する堅牢な解析エンジンの設計思想と実装を伝授する。

—

1. なぜ「素朴なVBAスケジュール計算」は破綻するのか

多くの開発者が陥る罠は、タスクの依存関係（先行・後続）をただのループで上から順に計算しようとすることだ。
スケジュール計算は本質的に「有向グラフのトポロジカルソートとフォワード/バックワードパス計算」のアルゴリズムを要求される。

ここに「開始日固定」というハード制約が加わると、計算は一気に非線形化する。

• フォワードパス（順方向計算）: 通常は「先行タスクの終了日 ＋ ラグ」が後続の開始日になるが、開始日固定制約がある場合、「Max(先行由来の開始日, 固定制約日)」へと強制的に押し上げられる。
• 負のフロート（Negative Float）の発生: 固定制約によって押し上げられたタスクが、後続タスクのスケジュールを圧迫し、トータルフロートがマイナスに転落する。しかし、多くの簡易ツールはこの歪みを検知できず、スケジュールが「勝手に伸びた」ように錯覚する。

この歪みを数理的に暴き、どの制約がクリティカルパスをどれだけ歪めているかを定量化するのが今回のミッションだ。

—

2. 堅牢なエンジニアリング設計：データ構造とライフサイクル

VBAでこれを実現するためには、オブジェクトのライフサイクルとメモリ効率を意識した設計が不可欠だ。セルを直接叩く泥臭いコードは、パフォーマンスを著しく落とすだけでなく、複雑なネットワーク計算でデバッグ不能なバグを生む。

アーキテクチャの要件

1. インメモリ処理（Dictionaryとユーザー定義型）: タスク群を一度メモリ上の `Scripting.Dictionary` に展開し、ポインタ（タスクID）ベースで高速にグラフ走査を行う。
2. 2パス計算エンジン:

• Pass 1: フォワードパス（早期開始日 / 早期終了日 の算出 ＋ 固定制約の適用）
• Pass 2: バックワードパス（最遅開始日 / 最遅終了日 の算出 ＋ フロート計算）

3. 歪み度（Distortion Index）の定量化: 固定制約が本来のネットワークパスからどれだけスケジュールを乖離させたかをスコア化する。

—

3. プロダクションコード：制約歪み解析エンジン

以下のコードは、Excelシート上のタスク定義を読み込み、開始日固定制約によるクリティカルパスの歪みを解析してレポートシートを出力する実用モジュールだ。そのままコピー＆ペーストして検証環境で動かしてほしい。

Option Explicit

‘ ==============================================================================
‘ 構造体定義: タスクノード
‘ ==============================================================================
Type TaskNode
ID As String
Name As String
Duration As Double
StartConstraint As Double ‘ 0の場合は制約なし、値がある場合は開始日固定制約（シリアル値）
Predecessors As String ‘ カンマ区切りの先行タスクID

‘ 計算結果
EarlyStart As Double
EarlyFinish As Double
LateStart As Double
LateFinish As Double
TotalFloat As Double
IsCritical As Boolean

‘ 歪み解析用
OriginalEarlyStart As Double ‘ 制約を無視した場合の早期開始日
ConstraintDistortion As Double ‘ 制約による押し上げ日数
End Type

‘ ==============================================================================
‘ メインエントリーポイント: クリティカルパス歪み解析の実行
‘ ==============================================================================
Sub RunCriticalPathDistortionAnalysis()
Dim wsData As Worksheet
Dim wsReport As Worksheet
Dim taskDict As Object
Set taskDict = CreateObject(“Scripting.Dictionary”)

On Error GoTo ErrorHandler

‘ 1. ワークシートの取得 (※実運用に合わせたシート名に変更してください)
Set wsData = ThisWorkbook.Sheets(“Tasks”)

‘ 2. データのロードと初期化
LoadTaskData wsData, taskDict
If taskDict.Count = 0 Then
MsgBox “解析対象のタスクが存在しません。”, vbExclamation
Exit Sub
End If

‘ 3. スケジュール計算エンジン実行 (Pass 1: フォワードパス)
ExecuteForwardPass taskDict

‘ 4. スケジュール計算エンジン実行 (Pass 2: バックワードパス)
ExecuteBackwardPass taskDict

‘ 5. 制約歪みの定量評価
EvaluateDistortion taskDict

‘ 6. レポート出力
Set wsReport = GetOrCreateReportSheet(“CP_Distortion_Report”)
OutputReport taskDict, wsReport

MsgBox “クリティカルパスの歪み解析が完了しました。”, vbInformation
Exit Sub

ErrorHandler:
MsgBox “予期せぬエラーが発生しました: ” & Err.Description, vbCritical
End Sub

‘ ==============================================================================
‘ データロード
‘ ==============================================================================
Private Sub LoadTaskData(ws As Worksheet, dict As Object)
Dim lastRow As Long
Dim i As Long
Dim node As TaskNode

lastRow = ws.Cells(ws.Rows.Count, “A”).End(xlUp).Row
If lastRow < 2 Then Exit Sub For i = 2 To lastRow node.ID = CStr(ws.Cells(i, 1).Value) node.Name = CStr(ws.Cells(i, 2).Value) node.Duration = CDbl(ws.Cells(i, 3).Value) ' 開始日固定制約 (空白の場合は 0) If IsNumeric(ws.Cells(i, 4).Value) And ws.Cells(i, 4).Value <> “” Then
node.StartConstraint = CDbl(ws.Cells(i, 4).Value)
Else
node.StartConstraint = 0
End If

node.Predecessors = CStr(ws.Cells(i, 5).Value)

‘ 初期値設定
node.EarlyStart = 0
node.EarlyFinish = 0
node.LateStart = 1E+30
node.LateFinish = 1E+30
node.TotalFloat = 0
node.IsCritical = False
node.ConstraintDistortion = 0

If Not dict.Exists(node.ID) Then
dict.Add node.ID, node
End If
Next i
End Sub

‘ ==============================================================================
‘ フォワードパス (順方向計算 & 制約適用)
‘ ==============================================================================
Private Sub ExecuteForwardPass(dict As Object)
Dim resolved As Object
Set resolved = CreateObject(“Scripting.Dictionary”)

Dim progress As Boolean
progress = True

‘ 依存関係を解決しながらループ (簡易トポロジカルソート)
Do While resolved.Count < dict.Count And progress progress = False Dim key As Variant For Each key In dict.Keys If Not resolved.Exists(key) Then Dim node As TaskNode node = dict(key) ' 先行タスクがすべて計算済みか確認 If ArePredecessorsResolved(node.Predecessors, resolved) Then ' 先行タスクからの最遅終了日を早期開始日とする Dim maxPredFinish As Double maxPredFinish = GetMaxPredecessorFinish(node.Predecessors, dict) ' 制約なしの場合の早期開始日を保持 node.OriginalEarlyStart = maxPredFinish ' 開始日固定制約の適用 (SNETのロジック) If node.StartConstraint > 0 Then
If node.StartConstraint > maxPredFinish Then
node.EarlyStart = node.StartConstraint
node.ConstraintDistortion = node.StartConstraint – maxPredFinish
Else
node.EarlyStart = maxPredFinish
End If
Else
node.EarlyStart = maxPredFinish
End If

node.EarlyFinish = node.EarlyStart + node.Duration

dict(key) = node
resolved.Add key, True
progress = True
End If
End If
Next key
Loop
End Sub

‘ ==============================================================================
‘ バックワードパス (逆方向計算 & フロート算出)
‘ ==============================================================================
Private Sub ExecuteBackwardPass(dict As Object)
‘ 1. プロジェクト全体のプロジェクト完了日(Max EarlyFinish)を特定
Dim maxProjectFinish As Double
maxProjectFinish = 0

Dim key As Variant
For Each key In dict.Keys
Dim node As TaskNode
node = dict(key)
If node.EarlyFinish > maxProjectFinish Then
maxProjectFinish = node.EarlyFinish
End If
Next key

‘ 2. 後続を持たないタスクのLateFinishをプロジェクト完了日に設定
For Each key In dict.Keys
node = dict(key)
If Not HasSuccessors(node.ID, dict) Then
node.LateFinish = maxProjectFinish
node.LateStart = node.LateFinish – node.Duration
node.TotalFloat = node.LateStart – node.EarlyStart
node.IsCritical = (Abs(node.TotalFloat) < 0.001) dict(key) = node End If Next key ' 3. 逆方向へ伝播計算 (簡略化のため複数回イテレーション) Dim i As Long For i = 1 To dict.Count For Each key In dict.Keys node = dict(key) ' 後続タスクに基づくLateFinishの更新 Dim minSuccLateStart As Double minSuccLateStart = GetMinSuccessorLateStart(node.ID, dict) If minSuccLateStart < 1E+29 Then If minSuccLateStart < node.LateFinish Then node.LateFinish = minSuccLateStart End If End If node.LateStart = node.LateFinish - node.Duration node.TotalFloat = node.LateStart - node.EarlyStart node.IsCritical = (Abs(node.TotalFloat) < 0.001) dict(key) = node Next key Next i End Sub ' ============================================================================== ' 歪み評価 ' ============================================================================== Private Sub EvaluateDistortion(dict As Object) ' ここでは個別のConstraintDistortionがすでに計算されているため、 ' レポート出力時にこれを活用する。 End Sub ' ============================================================================== ' ヘルパー関数群 ' ============================================================================== Private Function ArePredecessorsResolved(predStr As String, resolved As Object) As Boolean If Trim(predStr) = "" Then ArePredecessorsResolved = True Exit Function End If Dim arr() As String arr = Split(predStr, ",") Dim i As Long For i = LBound(arr) To UBound(arr) If Not resolved.Exists(Trim(arr(i))) Then ArePredecessorsResolved = False Exit Function End If Next i ArePredecessorsResolved = True End Function Private Function GetMaxPredecessorFinish(predStr As String, dict As Object) As Double If Trim(predStr) = "" Then GetMaxPredecessorFinish = 0 Exit Function End If Dim arr() As String arr = Split(predStr, ",") Dim maxVal As Double maxVal = 0 Dim i As Long For i = LBound(arr) To UBound(arr) Dim pid As String pid = Trim(arr(i)) If dict.Exists(pid) Then Dim pNode As TaskNode pNode = dict(pid) If pNode.EarlyFinish > maxVal Then
maxVal = pNode.EarlyFinish
End If
End If
Next i
GetMaxPredecessorFinish = maxVal
End Function

Private Function HasSuccessors(taskId As String, dict As Object) As Boolean
Dim key As Variant
For Each key In dict.Keys
Dim node As TaskNode
node = dict(key)
If InStr(1, “,” & node.Predecessors & “,”, “,” & taskId & “,”, vbTextCompare) > 0 Then
HasSuccessors = True
Exit Function
End If
Next key
HasSuccessors = False
End Function

Private Function GetMinSuccessorLateStart(taskId As String, dict As Object) As Double
Dim minVal As Double
minVal = 1E+30

Dim key As Variant
For Each key In dict.Keys
Dim node As TaskNode
node = dict(key)
If InStr(1, “,” & node.Predecessors & “,”, “,” & taskId & “,”, vbTextCompare) > 0 Then
If node.LateStart < minVal Then minVal = node.LateStart End If End If Next key GetMinSuccessorLateStart = minVal End Function Private Function GetOrCreateReportSheet(sheetName As String) As Worksheet Dim ws As Worksheet On Error Resume Next Set ws = ThisWorkbook.Sheets(sheetName) On Error GoTo 0 If ws Is Nothing Then Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) ws.Name = sheetName Else ws.Cells.Clear End If Set GetOrCreateReportSheet = ws End Function Private Sub OutputReport(dict As Object, ws As Worksheet) ' ヘッダー出力 ws.Cells(1, 1).Value = "タスクID" ws.Cells(1, 2).Value = "タスク名" ws.Cells(1, 3).Value = "期間" ws.Cells(1, 4).Value = "開始日制約" ws.Cells(1, 5).Value = "早期開始" ws.Cells(1, 6).Value = "早期終了" ws.Cells(1, 7).Value = "トータルフロート" ws.Cells(1, 8).Value = "クリティカルパス" ws.Cells(1, 9).Value = "制約歪み日数(日)" Dim r As Long r = 2 Dim key As Variant For Each key In dict.Keys Dim node As TaskNode node = dict(key) ws.Cells(r, 1).Value = node.ID ws.Cells(r, 2).Value = node.Name ws.Cells(r, 3).Value = node.Duration ws.Cells(r, 4).Value = IIf(node.StartConstraint = 0, "-", node.StartConstraint) ws.Cells(r, 5).Value = node.EarlyStart ws.Cells(r, 6).Value = node.EarlyFinish ws.Cells(r, 7).Value = node.TotalFloat ws.Cells(r, 8).Value = IIf(node.IsCritical, "YES", "NO") ws.Cells(r, 9).Value = node.ConstraintDistortion ' 歪みが発生しているタスクを視覚的にハイライト If node.ConstraintDistortion > 0 Then
ws.Cells(r, 9).Interior.Color = RGB(255, 230, 230)
End If

r = r + 1
Next key

ws.Columns.AutoFit
End Sub

—

4. データベース連携・外部システム連携時の注意点

実務において、このVBAツールを単体のExcelマクロとして完結させるべきではない。プロジェクトデータは多くの場合、SQL Server、PostgreSQL、あるいはkintoneなどの外部DBやAPIで管理されている。

ここでデータベース連携を行う際の鉄則を挙げておく。

1. トランザクションと一括ロード:
タスク数が数千件規模になると、セルへの書き込みやDBからの個別クエリ発行は致命的なボトルネックになる。必ず一括読み込み（ADODB.Recordsetからメモリ配列への転送）を行い、計算完了後の一括書き込み（Bulk Insert / Update）を徹底すること。
2. 制約変更の監査証跡（Audit Trail）:
VBAによる解析結果として「どの制約がクリティカルパスを何日歪めているか」が判明したとき、それを勝手にDBへ書き戻してはならない。制約の削除や変更はプロジェクトマネージャーの意思決定を伴うため、あくまで「分析レポートの提示」にとどめ、修正提案リストとして出力する設計に留めるのが安全保障上、正しい。

—

5. チーフアーキテクトからの総括

「開始日固定」制約は、現場の都合による逃げ道として安易に使われがちだ。しかし、その甘えがクリティカルパスを歪め、プロジェクトの予兆なき遅延を生む最大の元凶となる。

今回紹介したVBAエンジンは、単なるスケジュール計算機ではない。「人間が組み込んだ都合のいい制約が、プロジェクトの論理構造をどれだけ歪めているかを数値化するレントゲン写真」である。

このツールをあなたの組織の業務プロセスに組み込み、感覚に頼った属人的なスケジュール管理から脱却せよ。それこそが、エンジニアリングの力でプロジェクトを勝利に導く唯一の道である。