MS Project VBA：主项目最后子项目最后行判定与依赖匹配优化

问题背景 #

主项目包含3个插入子项目，现有宏通过唯一引用遍历任务，跨子项目创建依赖关联。当无匹配引用（如外部依赖未在子项目中）时，宏会错误关联到最后找到的任务。之前通过统计计划总行数、忽略子搜索返回的最后行结果来规避，但这导致最后子项目的最后行合法交付项无法被识别。

优化思路 #

替代统计总行数的笨拙方法，改为：

• 遍历搜索时，标记是否找到匹配的任务
• 若未找到匹配项，直接获取搜索结果的最后一行任务的Text1字段值
• 判断该值是否包含DEP关键字，若是则弹出告警提示，避免错误关联

修改后的宏代码 #

Sub CreateCrossProjectDependencies()
    Dim mainProj As Project
    Dim subProj As Project
    Dim mainTask As Task
    Dim subTask As Task
    Dim foundMatch As Boolean
    Dim lastTaskText1 As String
    
    Set mainProj = ActiveProject
    
    ' 遍历主项目任务
    For Each mainTask In mainProj.Tasks
        If Not mainTask Is Nothing And mainTask.Text1 <> "" Then
            foundMatch = False
            ' 遍历所有子项目
            For Each subProj In mainProj.Subprojects
                If subProj.IsLoaded Then
                    ' 搜索子项目中Text1匹配的任务
                    For Each subTask In subProj.Tasks
                        If subTask.Text1 = mainTask.Text1 Then
                            ' 创建跨项目依赖
                            mainTask.Predecessors.Add subTask.UniqueID, pjFinishToStart
                            foundMatch = True
                            Exit For
                        End If
                    Next subTask
                    If foundMatch Then Exit For
                End If
            Next subProj
            
            ' 未找到匹配项时检查最后行任务
            If Not foundMatch Then
                ' 获取最后一个子项目的最后一行任务
                If mainProj.Subprojects.Count > 0 Then
                    Set subProj = mainProj.Subprojects(mainProj.Subprojects.Count)
                    If subProj.IsLoaded And subProj.Tasks.Count > 0 Then
                        lastTaskText1 = subProj.Tasks(subProj.Tasks.Count).Text1
                        If InStr(1, lastTaskText1, "DEP", vbTextCompare) > 0 Then
                            MsgBox "警告：任务 [" & mainTask.Name & "] 的引用 [" & mainTask.Text1 & "] 未找到匹配项，且最后行任务包含DEP标识，未创建错误关联。", vbExclamation
                        End If
                    End If
                End If
            End If
        End If
    Next mainTask
End Sub

原临时实现代码（对比参考） #

Sub TempCreateDependencies()
    Dim mainProj As Project
    Dim subProj As Project
    Dim mainTask As Task
    Dim subTask As Task
    Dim totalRows As Integer
    Dim currentRow As Integer
    
    Set mainProj = ActiveProject
    totalRows = 0
    
    ' 统计总行数
    For Each subProj In mainProj.Subprojects
        If subProj.IsLoaded Then
            totalRows = totalRows + subProj.Tasks.Count
        End If
    Next subProj
    
    ' 遍历主项目任务
    For Each mainTask In mainProj.Tasks
        If Not mainTask Is Nothing And mainTask.Text1 <> "" Then
            currentRow = 0
            For Each subProj In mainProj.Subprojects
                If subProj.IsLoaded Then
                    For Each subTask In subProj.Tasks
                        currentRow = currentRow + 1
                        ' 忽略最后一行
                        If currentRow = totalRows Then Exit For
                        If subTask.Text1 = mainTask.Text1 Then
                            mainTask.Predecessors.Add subTask.UniqueID, pjFinishToStart
                            Exit For
                        End If
                    Next subTask
                End If
            Next subProj
        End If
    Next mainTask
End Sub

说明 #

• 修改后的宏通过foundMatch标记是否找到匹配任务，无需统计总行数
• 未匹配时直接定位最后子项目的最后行任务，检查Text1是否含DEP并告警
• 保留了合法任务的关联逻辑，同时避免了无匹配时的错误关联

内容的提问来源于stack exchange，提问作者Miles