Excel导入MS Project的VBA问题：指定工时清除与上传优化

我创建了一个Excel文件用于将已完成的工时数据导入MS Project，但遇到两个问题：

1. 如何通过任务ID在上传前完全清除指定工作分配的工时？
2. 是否存在更简便的方式将数据上传至MS Project？

我尝试用宏录制器生成了代码，但代码和特定字符串绑定，仅适用于当前文件，可用代码如下：

'It's work
Sub SetActualHours()
Dim tsk As Task
Dim names As String
For Each tsk In ActiveProject.Tasks
        Dim asn As Assignment
        For Each asn In tsk.Assignments
            If asn.UniqueID = 2097153 Then  '  ID Resource (UID =1048577, [1048577+1048576=2097153] uniqueID + 1048576
                Dim tsv As TimeScaleValues
                Set tsv = asn.TimeScaleData(StartDate:=#6/26/2024#, EndDate:=#6/28/2024# _
                    , Type:=pjAssignmentTimescaledActualWork, TimeScaleUnit:=pjTimescaleDays)
                ' tsv(1).Clear for clear value
                 tsv(1).Value = 60
                 tsv(2).Value = 60
                 
            End If
        Next asn
Next tsk
End Sub

另外，我希望仅清除UniqueID为2097153的工作工时，但当前ClearActualHours宏会清除所有项目数据，需修复该代码：

Sub ClearActualHours()
Dim tsk As Task
Dim names As String
projStart = ActiveProject.ProjectStart
projEnd = ActiveProject.ProjectFinish
For Each tsk In ActiveProject.Tasks
        Dim asn As Assignment
        For Each asn In tsk.Assignments
            If asn.UniqueID = 2097153 Then
            Dim TSValues As TimeScaleValues
            Set TSValues = asn.TimeScaleData(projStart, projEnd, pjAssignmentTimescaledActualWork, pjTimescaleYears)
                Dim tsv As TimeScaleValue
            For Each tsv In TSValues
          tsv.Clear
         Next tsv
        asn.Work = 0
       End If
Next asn
  tsk.Work = 0
     Next tsk
End Sub

修复后的ClearActualHours宏 #

原代码的问题点：

• tsk.Work = 0位于外层循环，会无条件清除所有任务的工时，需移除或仅在指定分配下执行
• 时间刻度使用pjTimescaleYears无法覆盖细粒度的工时数据，改为pjTimescaleDays确保彻底清除

修复后的代码：

Sub ClearActualHours()
Dim tsk As Task
Dim asn As Assignment
Dim TSValues As TimeScaleValues
Dim tsv As TimeScaleValue
Dim projStart As Date
Dim projEnd As Date

projStart = ActiveProject.ProjectStart
projEnd = ActiveProject.ProjectFinish

For Each tsk In ActiveProject.Tasks
    For Each asn In tsk.Assignments
        If asn.UniqueID = 2097153 Then
            ' 用日粒度覆盖所有时段的实际工时
            Set TSValues = asn.TimeScaleData(projStart, projEnd, pjAssignmentTimescaledActualWork, pjTimescaleDays)
            For Each tsv In TSValues
                tsv.Clear
            Next tsv
            ' 清除该分配的总工时
            asn.Work = 0
        End If
    Next asn
Next tsk
End Sub

更简便的导入方式推荐 #

除VBA宏外，可尝试以下无代码/低代码方案：

• MS Project内置导入向导：通过「文件>打开」选择Excel文件，直接映射任务ID、资源ID、实际工时等字段，自动完成数据导入
• Power Query同步：在Excel中整理好工时数据，用Power Query建立与MS Project的连接，实现批量更新
• 云端版本集成：若使用Project Online/Server，可直接通过Excel同步功能将数据推送至云端项目

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