Создание скрипта VBA для сопоставления полей Excel для повышения эффективности проекта

#excel #vba #ms-project

Вопрос:

Итак, у меня есть файл Microsoft Project с примерно 600 строками родительских задач. Мне нужно импортировать новые данные из Excel в этот файл проекта с помощью Мастера импорта, а затем запустить сценарий, который создает четыре вехи под каждой родительской задачей, а затем сопоставляет поля даты и текста из файла Excel в правильные ячейки в файле проекта. Если родительская задача уже имеет четыре вехи (и не является новой родительской задачей), сценарий обновляет поля даты и текста для задачи новыми данными. Для этого я использовал следующий сценарий, и он работает. Однако для запуска требуется более 10 минут. Я знаю, что это не самый эффективный способ написания этого сценария. Кто-нибудь может помочь мне изменить сценарий, чтобы он выполнялся меньше времени?

 Sub InsertSubTask()

    Dim tsk As Task
    For Each tsk In ActiveProject.Tasks
        If tsk.Flag1 And tsk.OutlineChildren.Count = 0 Then
            With ActiveProject
                tsk.Name = tsk.Text5   " "   "-"   tsk.Name
                .Tasks.Add tsk.Name   " "   "-"   " "   "Milestone 1", tsk.ID   1
                .Tasks.Add tsk.Name   " "   "-"   " "   "Milestone 2", tsk.ID   2
                .Tasks.Add tsk.Name   " "   "-"   " "   "Milestone3", tsk.ID   3
                .Tasks.Add tsk.Name   " "   "-"   " "   "Milestone4", tsk.ID   4
                
                .Tasks(tsk.ID   1).OutlineIndent
                .Tasks(tsk.ID   2).OutlineIndent
                .Tasks(tsk.ID   3).OutlineIndent
                .Tasks(tsk.ID   4).OutlineIndent
                
                .Tasks(tsk.ID   1).Start = DateAdd("d", -1, tsk.Date4)
                .Tasks(tsk.ID   2).Start = tsk.Date2
                .Tasks(tsk.ID   3).Start = tsk.Date4
                .Tasks(tsk.ID   4).Start = tsk.Date3
         
                tsk.Text10 = "Example"
                .Tasks(tsk.ID   1).Text10 = "Example"
                .Tasks(tsk.ID   2).Text10 = "Example"
                .Tasks(tsk.ID   3).Text10 = "Example"
                .Tasks(tsk.ID   4).Text10 = "Example"
                
                tsk.Text18 = "MILESTONE"
                .Tasks(tsk.ID   2).Text18 = "MILESTONE"
                
                .Tasks(tsk.ID   1).BaselineStart = tsk.Date5
                .Tasks(tsk.ID   2).BaselineStart = tsk.Date2
                .Tasks(tsk.ID   3).BaselineStart = tsk.Date4
                .Tasks(tsk.ID   4).BaselineFinish = tsk.Date3
                .Tasks(tsk.ID   2).ActualFinish = tsk.Date7
                
                          
                
            End With
        End If
        
        Next tsk

    For Each tsk In ActiveProject.Tasks
            If tsk.Flag1 And tsk.OutlineChildren.Count = 4 Then
                With ActiveProject
                    
                    .Tasks(tsk.ID   1).Start = DateAdd("d", -1, tsk.Date4)
                    .Tasks(tsk.ID   2).Start = tsk.Date2
                    .Tasks(tsk.ID   3).Start = tsk.Date4
                    .Tasks(tsk.ID   4).Start = tsk.Date3
                    
                    
                    .Tasks(tsk.ID   1).BaselineStart = tsk.Date5
                    .Tasks(tsk.ID   2).BaselineStart = tsk.Date2
                    .Tasks(tsk.ID   3).BaselineStart = tsk.Date4
                    .Tasks(tsk.ID   4).BaselineFinish = tsk.Date3
                    .Tasks(tsk.ID   2).ActualFinish = tsk.Date7
                    
                    
                End With
            End If
            
            Next tsk
        
End Sub
 

Комментарии:

1. Вероятно, лучше в стеке проверки кода.

2. Какая часть работает медленно-мастер импорта или этот макрос? Если это мастер, опубликуйте образец данных, которые объединяются.

3. Нет, волшебник быстр. Это макрос.