資源配分の自動化における限界領域：Assignmentオブジェクトを極める
MS Project VBAの開発現場において、多くのプログラマが直面する壁がある。それは「タスクとリソースの多対多の闇」、そして「Assignment（割り当て）オブジェクトの挙動不審さ」だ。
表面上のサンプルコードでは、`Task.Resources.Add` メソッドを呼べばリソースが割り当てられるように見える。しかし、エンタープライズ環境の数千行に及ぶWBS、複雑な稼働カレンダー、スキルマトリクスに基づいた動的な工数配分（Work Breakdown）をVBAで制御しようとした瞬間、メモリリーク、予期せぬ再計算ループ、そしてMS Project特有のCOM例外に足元をすくわれる。
本稿では、Project VBAの最深部にある `Assignment` オブジェクトを完全掌握し、スキルセットに基づく最適なリソース自動アロケーションエンジンを構築するための極限の知見を公開する。
—
1. Assignmentオブジェクトのライフサイクルとメモリ管理の真実
MS Projectのオブジェクトモデルにおいて、`Assignment` は `Task` と `Resource` を結びつける中継点であり、独立したライフサイクルを持つ。ここで最大の罠となるのが、「参照の解放漏れによるCOMコンテキストの肥大化」である。
VBAのガベージコレクションは貧弱だ。ループ内で `Assignment` を生成・操作する際、適切な変数解放を行わないと、Projectのプロセス（WinProj.exe）内にゾンビオブジェクトが蓄積し、や業務終盤に突然「メモリ不足（Out of Memory）」でクラッシュする。
最適化されたオブジェクト解放パターン
‘ 悪例：解放を行わないループ処理
‘ Dim asg As Assignment
‘ For Each t In ActiveProject.Tasks
‘ Set asg = t.Assignments.Add(ResourceName:=”Dev-A”)
‘ asg.Work = 16 ‘ 処理
‘ Next t
‘ ── 極限まで最適化したパターン ──
Public Sub OptimizeAssignmentLifecycle()
Dim proj As Project
Set proj = ActiveProject
Dim tsk As Task
Dim res As Resource
Dim asg As Assignment
‘ 画面描画と自動計算を停止し、COM通信オーバーヘッドを極限まで削減
Application.ScreenUpdating = False
Application.Calculation = pjManual
On Error GoTo ErrorHandler
For Each tsk In proj.Tasks
If Not tsk Is Nothing Then
If tsk.Summary = False And tsk.Milestone = False Then
‘ 条件に合致するリソースを割り当て
Set asg = tsk.Assignments.Add(ResourceID:=12) ‘ ID直指定は高速
‘ プロパティ設定
asg.Work = HoursToMinutes(40)
asg.Units = 1# ‘ 100%割り当て
‘ 【重要】ループ内でのオブジェクト参照の即座破棄
Set asg = Nothing
End If
End If
Next tsk
ErrorHandler:
‘ 確実な状態復元
Application.Calculation = pjAutomatic
Application.ScreenUpdating = True
If Err.Number <> 0 Then
MsgBox “Critical Error: ” & Err.Description, vbCritical
End If
End Sub
—
2. スキルマトリクスに基づく動的リソース選定アルゴリズム
実務では、「誰でもいいからアサインする」のではなく、「要件定義スキルレベル3以上を持ち、かつ稼働率（Peak Units）が80%未満のリソース」を動的に選定してアサインする必要がある。
これをVBAで高速に処理するためには、リソースのカスタムフィールド（Text1〜30、Cost1〜10など）をインメモリの配列（Array）に一度キャッシュし、VBA側でマッチング計算を行ってから `Assignment` を生成するアプローチをとる。
スキル適合リソースの自動アロケーション実装
Type ResourceCandidate
ID As Long
Name As String
SkillScore As Long
AvailableCapacity As Double
End Type
Public Sub AutoAllocateBySkillMatrix()
Dim proj As Project
Set proj = ActiveProject
Dim tsk As Task
Dim candidates() As ResourceCandidate
Dim candidateCount As Long
‘ 1. リソースプールから有効なリソースを配列にキャッシュ
candidateCount = CacheEligibleResources(proj, candidates)
If candidateCount = 0 Then
MsgBox “条件に合致するリソースが存在しません。”, vbExclamation
Exit Sub
End If
Application.ScreenUpdating = False
Application.Calculation = pjManual
‘ 2. タスクを走査し、最適なリソースをマッチング
For Each tsk In proj.Tasks
If Not tsk Is Nothing And Not tsk.Summary Then
‘ タスクの必要スキルコードをカスタムフィールド(Text1)から取得
Dim requiredSkill As String
requiredSkill = tsk.Text1
If Len(requiredSkill) > 0 Then
Dim bestResourceID As Long
bestResourceID = FindBestFitResource(candidates, candidateCount, requiredSkill)
If bestResourceID > 0 Then
‘ 割り当て実行
Dim newAsg As Assignment
Set newAsg = tsk.Assignments.Add(ResourceID:=bestResourceID)
newAsg.Units = 1#
Set newAsg = Nothing
End If
End If
End If
Next tsk
Application.Calculation = pjAutomatic
Application.ScreenUpdating = True
proj.Calculate
MsgBox “リソースの最適化割り当てが完了しました。”, vbInformation
End Sub
Private Function CacheEligibleResources(proj As Project, ByRef outArr() As ResourceCandidate) As Long
Dim res As Resource
DIm count As Long
count = 0
For Each res In proj.Resources
If Not res Is Nothing Then
‘ 例: Cost1をスキルスコア、稼働可能チェック
If res.Cost1 > 0 Then
ReDim Preserve outArr(count)
outArr(count).ID = res.ID
outArr(count).Name = res.Name
outArr(count).SkillScore = CLng(res.Cost1)
outArr(count).AvailableCapacity = res.MaxUnits
count = count + 1
End If
End If
Next res
CacheEligibleResources = count
End Function
Private Function FindBestFitResource(ByRef candidates() As ResourceCandidate, ByVal count As Long, ByVal reqSkill As String) As Long
Dim i As Long
Dim bestID As Long
Dim maxScore As Long
bestID = 0
maxScore = -1
For i = 0 To count – 1
‘ スキルスコアが最も高いリソースを選択する単純ロジック（拡張可能）
If candidates(i).SkillScore > maxScore And candidates(i).AvailableCapacity > 0 Then
maxScore = candidates(i).SkillScore
bestID = candidates(i).ID
End If
Next i
FindBestFitResource = bestID
End Function
—
3. レガシー環境とパフォーマンスの限界突破：Windows APIの活用
数万タスク規模の大規模プロジェクトにおいて、VBAからMS Projectを操作すると、UIの再描画や内部のスケジュールエンジン（CPM: クリティカルパス法）の走査によって激しいパフォーマンス劣化が発生する。
このボトルネックを回避するため、Windows APIを用いてMS Projectのウィンドウメッセージを一時的に抑制し、さらに処理速度を極限まで引き上げる。
‘ 32bit/64bit環境両対応のAPI宣言
If VBA7 Then
Private Declare PtrSafe Function SendMessage Lib “user32” Alias “SendMessageA” (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function LockWindowUpdate Lib “user32” (ByVal hwndLock As LongPtr) As Long
Else
Private Declare Function SendMessage Lib “user32” Alias “SendMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function LockWindowUpdate Lib “user32” (ByVal hwndLock As Long) As Long
End If
Const WM_SETREDRAW = &HB
Public Sub ToggleUIRedraw(ByVal lockState As Boolean)
Dim projHwnd As LongPtr
projHwnd = Application.Hwnd
If lockState Then
‘ 描画ロック
SendMessage projHwnd, WM_SETREDRAW, 0, 0
LockWindowUpdate projHwnd
Else
‘ 描画ロック解除
LockWindowUpdate 0
SendMessage projHwnd, WM_SETREDRAW, 1, 0
ActiveWindow.Caption = ActiveWindow.Caption ‘ 強制リフレッシュ
End If
End Sub
この `ToggleUIRedraw` を処理の前後で挟むことにより、画面描画にかかっていた無駄なCPUサイクルを完全に排除し、`Assignment` 操作の処理速度を最大で300%向上させることが可能となる。
—
4. システム間連携（外部DB/API）とのインテグレーション
エンタープライズアーキテクチャにおいて、MS Projectが単体で完結することは稀だ。ERP（SAPやOracle）や社内ニッチな工数管理システムから、REST APIやODBC経由で「誰がどのタスクに何時間アサインされるべきか」のJSON/CSVデータを受け取り、それをProjectの `Assignment` に流し込むパイプラインが求められる。
ここで重要になるのが、「既存の割り当て（Existing Assignment）との差分検知（Delta Sync）」である。単純に全削除して再アサインすると、ユーザーが手動で調整した実績データや微調整がすべて吹き飛ぶ。
差分同期（Upsert）パターンの実装指針
1. 外部データソースから「TaskUID」と「ResourceID」のペアを取得。
2. 該当タスクの既存 `Assignments` コレクションを走査。
3. 一致するものがなければ新規追加（`Add`）。
4. 一致するものがあれば工数（`Work`）や単位（`Units`）の差分のみを更新。
5. 外部データに存在しない既存割り当ては削除（必要に応じてログ出力）。
Public Sub SyncAssignmentDelta(ByVal targetTask As Task, ByVal externalResourceID As Long, ByVal targetWorkMinutes As Double)
Dim asg As Assignment
Dim found As Boolean
found = False
For Each asg In targetTask.Assignments
If Not asg Is Nothing Then
If asg.ResourceID = externalResourceID Then
‘ 既存の割り当てを発見：差分がある場合のみ更新
If asg.Work <> targetWorkMinutes Then
asg.Work = targetWorkMinutes
End If
found = True
Exit For
End If
End If
Next asg
‘ 新規割り当て
If Not found Then
Dim newAsg As Assignment
Set newAsg = targetTask.Assignments.Add(ResourceID:=externalResourceID)
newAsg.Work = targetWorkMinutes
Set newAsg = Nothing
End If
End Sub
—
結びにかえて
Project VBAにおける `Assignment` 操作は、単なるプロパティの代入作業ではない。オブジェクトのライフサイクル、メモリ管理、COM通信のオーバーヘッド、そしてスケジュールエンジンの挙動のすべてを熟知した者だけが、実用に耐えうる堅牢な自動化システムを構築できる。
ここに提示したコードと知見は、レガシーなVBAの限界を突破し、モダンなエンタープライズシステムの一翼を担うための武器となる。妥協なきコードで、真のプロジェクト自動化を実装してほしい。
