从Excel导入到MS Project时出现循环错误

我有一个读取Excel文件并将其转换为MS Project项目计划的工具。 它还将任务列表(uniqueID)打印回电子表格中,用于匹配Excel /项目任务。 这部分工作正常,我试图更新它,使Excel文件可以用来更新现有的计划。

下面的代码工作正常,除了两个项目任务,然后循环rest。 它也覆盖前两个任务,而不是仅使用uniqueID更新匹配的任务。

dim statements Set prApp = New MSProject.Application 'If fileToOpen <> False Then prApp.FileOpen "c:\users\faizal\desktop\Project1.mpp" Set CurrProject = prApp.ActiveProject With CurrProject Set lshtProjStage2 = ActiveWorkbook.Worksheets("Project Stage - Gate 2") lshtProjStage2.Activate ' Default place to start. llngRowCounter = 10 llngTaskCounter = 0 lintBoldCellCount = 0 lsCellContent = lshtProjStage2.Range("B10").Value lblnSkipAddTask = False lblnIndentNextCell = False lsPreviousCellContent = "" llngPerviousCellColour = -4142 llngPerviousTaskIndentLvl = 0 lblnPerviousCellBold = False lshtProjStage2.Range("G" & Trim(CStr(llngRowCounter))).Select lsTaskName = ActiveCell.Value lshtProjStage2.Range("C" & Trim(CStr(llngRowCounter))).Select start1 = ActiveCell.Value llngTaskCounter = llngTaskCounter + 1 ' Going to loop through cells A10 until we reach "Service Readiness" in column B which is currently on row 28. Do While lsCellContent <> "" lsCellContent = lshtProjStage2.Range("B" & Trim(CStr(llngRowCounter))).Value lshtProjStage2.Range("B" & Trim(CStr(llngRowCounter))).Select If llngRowCounter >= 10 Then lsPreviousCellContent = lshtProjStage2.Range("B" & Trim(CStr(llngRowCounter - 1))).Value llngPerviousCellColour = lshtProjStage2.Range("B" & Trim(CStr(llngRowCounter - 1))).Interior.ColorIndex lblnPerviousCellBold = lshtProjStage2.Range("B" & Trim(CStr(llngRowCounter - 1))).Font.Bold End If lshtProjStage2.Range("C" & Trim(CStr(llngRowCounter))).Select start1 = ActiveCell.Value lshtProjStage2.Range("L" & Trim(CStr(llngRowCounter))).Select guid = ActiveCell.Value If start1 = "" Then lblnSkipAddTask = True Else lblnSkipAddTask = False End If c1 = 11 For Each t In CurrProject.Tasks If lblnSkipAddTask = False Then ' find the excel file unique id in the Project file based on uniqueid and update ' actual start, actual finish, perecent complete and duration If t.UniqueID = guid Then t.Name = start1 't.Finish = fin 'need to exit the code once found to the next line in the excel sheet Exit For End If End If Next t c1 = c1 + 1 llngRowCounter = llngRowCounter + 1 lsCellContent = lshtProjStage2.Range("B" & Trim(CStr(llngRowCounter))).Value ' Check if cell content is <> "" if so carry on else goto Column B. If Trim(lsCellContent) = "" Then lsCellContent = lshtProjStage2.Range("C" & Trim(CStr(llngRowCounter))).Value & " " End If ' Check if in column B of this row we have "Service Readiness" If lshtProjStage2.Range("C" & Trim(CStr(llngRowCounter))).Value = "Service Readiness" Then lsCellContent = "" End If Loop CurrProject.SaveAs MsgBox ("Test Text" & CStr(datecount)) CleanExit: Exit Sub End With End Sub 

  1. 仔细查看存储在列L中的任务唯一标识(或者称为GUID)。前两项任务的任务唯一标识是否是两次?
  2. 此代码中只更新了任务名称,并使用列C(start)中的值更新; 这看起来是不正确的。
  3. 您的代码缩进是closures的,这可能会导致代码出现做一些不 – 修复您的缩进。
  4. End With语句的位置是错误的 – 将其移动到Loop行之后。
  5. 如果要更新实际值,请确保使用任务属性t.ActualStartt.ActualFinish