使用任务将具有相同 ID 的 Excel 数据添加到 MS Project - VBA

Question

在 excel 中，我从第二行（第一行=header）开始的第 "A" 列中有 ID 编号。在 "T" 列中，同一行上有该 ID 的持续时间。

在 MS Project 中，我有一个 ID 列和一个空的持续时间列。我想在正确的 ID 行上将 excel 的持续时间添加到 MS Project。

我想我可以通过使用任务和 For..To 循环来做到这一点。我将需要使用 excel 中的 ID 来查找 MS Project 中的任务，然后在 MS Project 中的相应任务中写入 excel 的持续时间。到目前为止，在一些帮助下，我的代码是：

'Find duration and assign to ID in Excel
For i = 2 To lastRow
date1 = .Cells(i, 15)
date2 = .Cells(i, 16)
    If .Cells(i, 18).Value = "No" Then
    answer = DateDiff("n", date1, date2)
    .Cells(i, 20) = answer
    End If
durationID = .Cells(i,1).Value
Next i

'Open MS Project and add Duration column
set wb = ActiveWorkBook
Set ws = wb.Sheets("Task_Table1")
Set appProj = CreateObject("Msproject.Application")
appProj.FileOpen "File1.mpp"
Set aProg = appProj.ActiveProject
appProj.Visible = True


lastTask = ActiveProject.Tasks.Count
taskID = ActiveProject.Tasks.ID

'Load Durations into MS Project to appropriate ID task
lastTask = ActiveProject.Tasks.Count
For i = 1 to lastTask
    If taskID = Application.Workbooks("File1").Sheets("Task_Table1").Cells(i, 1).Value Then
    answer.Copy
    appProj.SelectCell.ActiveCell
    end if
Next i

Answer 1

不是将持续时间复制到用户界面，而是将持续时间直接分配给任务对象。或者（根据下面的评论），更新实际开始和实际完成日期。包括执行这两项操作的代码，但如果您还打算更新实际开始时间和实际完成时间，则更新持续时间没有意义。

'Open MS Project
Set appProj = CreateObject("MSProject.Application")
appProj.FileOpen "File1.mpp"
Set aProg = appProj.ActiveProject
appProj.Visible = True

'Find duration and assign to task
Dim Duration As Long
Dim tsk as MSProject.Task
With ws
    For i = 2 To lastRow
        date1 = .Cells(i, 15)
        date2 = .Cells(i, 16)
        ' get a reference to the task object using the ID stored in Column A
        Set tsk = aProg.Tasks(.Cells(i, 1).Value)
        ' Update duration 
        If .Cells(i, 18).Value = "No" And IsDate(date1) And IsDate(date2) Then
            TotalMinutes = DateDiff("n", date1, date2)
            WorkingMinutes = appProj.DateDifference(date1, date2)
            .Cells(i, 20) = WorkingMinutes 
            tsk.Duration = WorkingMinutes
        End If
        ' update Actual Start and/or Actual Finish
        If IsDate(date1) Then
            tsk.ActualStart = date1
        End If
        If IsDate(date2) Then
            tsk.ActualFinish = date2
        End If
    Next i
End With

请注意，持续时间包含两次计算。 VBA DateDiff 函数 returns 两个日期之间的总分钟数，而 MS Project DateDifference 函数 returns 两个日期之间的工作分钟数。后者可能是您想要使用的。否则 1 天的持续时间（总共 1440 分钟）将变成 3 天的任务（1440 = 3 天 * 8 小时 * 60 minutes/hour）。

使用任务将具有相同 ID 的 Excel 数据添加到 MS Project - VBA

Using Tasks to Add Excel Data with Same ID to MS Project - VBA

excel

vba

ms-project