Блог

Этот вопрос касается не столько какого-либо приложения, сколько поиска алгоритма, который будет работать. У меня есть код для перемещения данных из 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" amp; i)
        strStartDate = WorksheetToOperate.Range("E" amp; i)
        strEndDate = WorksheetToOperate.Range("F" amp; i)
        Strresource = WorksheetToOperate.Range("J" amp; i)
        
        ' Import tasks
        If (WorksheetToOperate.Range("C" amp; i).Value <> "") And _
        (Not IsError(WorksheetToOperate.Range("C" amp; i).Value)) Then
            newproj.Tasks.Add strValue
        End If
        
        ' Import start date
        If (WorksheetToOperate.Range("E" amp; i).Value <> "") And _
        (Not IsError(WorksheetToOperate.Range("E" amp; i).Value)) Then
            newproj.Tasks(i - 18).Start = strStartDate
        End If
        
        ' Import end date
        If (WorksheetToOperate.Range("F" amp; i).Value <> "") And _
        (Not IsError(WorksheetToOperate.Range("F" amp; 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" amp; i).Value <> "") And _
        (Not IsError(WorksheetToOperate.Range("J" amp; i).Value)) Then
            newproj.Tasks(i - 18).ResourceNames = Strresource
        End If
    
    Next i 
  

Проблема пропуска пустых строк значительно упрощается за счет использования переменной объекта задачи для отслеживания задачи, которая была только что добавлена. Кроме того, используйте With инструкцию с объектом Worksheet для дальнейшего упрощения кода.

 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" amp; i)) Then
                Set t = newProj.Tasks.Add(CStr(.Range("C" amp; i)))
                t.Start = CDate(.Range("E" amp; i))
                t.Finish = CDate(Range("F" amp; i))
                t.ResourceNames = CStr(.Range("J" amp; 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" amp; i).Value) Then
        
            m = m   1
        
        Else
        
            strValue = WorksheetToOperate.Range("C" amp; i)
            strStartDate = WorksheetToOperate.Range("E" amp; i)
            strEndDate = WorksheetToOperate.Range("F" amp; i)
            Strresource = WorksheetToOperate.Range("J" amp; i)
        
            ' Import tasks
            If (WorksheetToOperate.Range("C" amp; i).Value <> "") And _
            (Not IsError(WorksheetToOperate.Range("C" amp; i).Value)) Then
                newproj.Tasks.Add strValue
            End If
            
            ' Import start date
            If (WorksheetToOperate.Range("E" amp; i).Value <> "") And _
            (Not IsError(WorksheetToOperate.Range("E" amp; i).Value)) Then
                newproj.Tasks(i - (18   m)).Start = strStartDate
            End If
            
            ' Import end date
            If (WorksheetToOperate.Range("F" amp; i).Value <> "") And _
            (Not IsError(WorksheetToOperate.Range("F" amp; 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" amp; i).Value <> "") And _
            (Not IsError(WorksheetToOperate.Range("J" amp; i).Value)) Then
                newproj.Tasks(i - (18   m)).ResourceNames = Strresource
            End If
            
        End If
    
    Next i