从Excel生成的MS Project跳过空行

问题描述

这个问题并不关乎任何应用程序，而是更多地寻找可行的算法。 我有一个代码，用于将数据从Excel移动到MS Project。我的当前解决方案将一直有效，直到之间没有空行为止。

我有从第19行开始的数据。因此19-18是第一任务，20-18是第二任务，依此类推。但是，一旦我之间有空行，就说：

Task 1 (row 19)
Task 2 (row 20)

Task 3 (row 22)

我的代码不起作用，因为MS Project中有任务2，下一个应该是3，但是22-18是4。有人对此有什么好的解决方案？

代码如下：

    ' Move data to project
    For i = 19 To lRow
    
        strValue = WorksheetToOperate.Range("C" & i)
        strStartDate = WorksheetToOperate.Range("E" & i)
        strEndDate = WorksheetToOperate.Range("F" & i)
        Strresource = WorksheetToOperate.Range("J" & i)
        
        ' Import tasks
        If (WorksheetToOperate.Range("C" & i).Value <> "") And _
        (Not IsError(WorksheetToOperate.Range("C" & i).Value)) Then
            newproj.Tasks.Add strValue
        End If
        
        ' Import start date
        If (WorksheetToOperate.Range("E" & i).Value <> "") And _
        (Not IsError(WorksheetToOperate.Range("E" & i).Value)) Then
            newproj.Tasks(i - 18).Start = strStartDate
        End If
        
        ' Import end date
        If (WorksheetToOperate.Range("F" & i).Value <> "") And _
        (Not IsError(WorksheetToOperate.Range("F" & i).Value)) Then
            newproj.Tasks(i - 18).Finish = strEndDate
        End If
        
        ' Import recources
        If Not ExistsInCollection(newproj.Resources,Strresource) Then _
        newproj.Resources.Add.Name = Strresource
        
        If (WorksheetToOperate.Range("J" & i).Value <> "") And _
        (Not IsError(WorksheetToOperate.Range("J" & i).Value)) Then
            newproj.Tasks(i - 18).ResourceNames = Strresource
        End If
    
    Next i 

解决方法

通过使用Task object变量来跟踪刚刚添加的任务，可以大大简化跳过空行的问题。另外，对工作表对象使用With语句可以进一步简化代码。

Sub CreateSchedule()

    Dim prj As MSProject.Application
    Set prj = CreateObject("MSProject.Application")
    prj.Visible = True
    
    Dim newProj As MSProject.Project
    Set newProj = prj.Projects.Add
    
    Dim i As Long
    Dim t As MSProject.Task
    
    For i = 19 To 28 'lRow
        With WorksheetToOperate
            If Not IsEmpty(.Range("C" & i)) Then
                Set t = newProj.Tasks.Add(CStr(.Range("C" & i)))
                t.Start = CDate(.Range("E" & i))
                t.Finish = CDate(Range("F" & i))
                t.ResourceNames = CStr(.Range("J" & i))
            End If
        End With
    Next i
    
End Sub

,

我设法使其与其他变量m一起使用：

    Dim m
    m = 0

    ' Move data to project
    For i = 19 To lRow
        
        If IsEmpty(WorksheetToOperate.Range("C" & i).Value) Then
        
            m = m + 1
        
        Else
        
            strValue = WorksheetToOperate.Range("C" & i)
            strStartDate = WorksheetToOperate.Range("E" & i)
            strEndDate = WorksheetToOperate.Range("F" & i)
            Strresource = WorksheetToOperate.Range("J" & i)
        
            ' Import tasks
            If (WorksheetToOperate.Range("C" & i).Value <> "") And _
            (Not IsError(WorksheetToOperate.Range("C" & i).Value)) Then
                newproj.Tasks.Add strValue
            End If
            
            ' Import start date
            If (WorksheetToOperate.Range("E" & i).Value <> "") And _
            (Not IsError(WorksheetToOperate.Range("E" & i).Value)) Then
                newproj.Tasks(i - (18 + m)).Start = strStartDate
            End If
            
            ' Import end date
            If (WorksheetToOperate.Range("F" & i).Value <> "") And _
            (Not IsError(WorksheetToOperate.Range("F" & i).Value)) Then
                newproj.Tasks(i - (18 + m)).Finish = strEndDate
            End If
            
            ' Import recources
            If Not ExistsInCollection(newproj.Resources,Strresource) Then _
            newproj.Resources.Add.Name = Strresource
            
            If (WorksheetToOperate.Range("J" & i).Value <> "") And _
            (Not IsError(WorksheetToOperate.Range("J" & i).Value)) Then
                newproj.Tasks(i - (18 + m)).ResourceNames = Strresource
            End If
            
        End If
    
    Next i