2016-06-05 8 views
0

Как вы можете прочитать из приведенных ниже кодов VBA для Project2013, цикл «for» занимает около 50-80 секунд, когда число задач достигает более 1000. Как я могу улучшить производительность? Есть ли метод «массива», например, excel VBA? Спасибо за вашу помощь!Как я могу улучшить производительность петли при использовании макроса проекта?

Sub Change_Color_By_Task_Status() 


' Expand all sub tasks 
    SelectSheet 
    OutlineShowAllTasks 
    SelectTaskField Row:=1, Column:="Name" 

' Clear all fields color 
    SelectSheet 
    FontEx CellColor:=16 
    SelectTaskField Row:=1, Column:="Name", RowRelative:=False 


Dim tskt As Task 
For Each tskt In ActiveProject.Tasks 
If Len(tskt.Name) > 0 Then 
    If Not tskt Is Nothing Then 
    If Not tskt.ExternalTask Then 
    If Not tskt.Summary Then  
     Select Case tskt.Text1 
      Case "Complete" 
       SelectRow Row:=tskt.ID, RowRelative:=False 
       'Font Color:=pjBlack 
       FontEx CellColor:=pjGray 
      Case "Yellow" 
       SelectRow Row:=tskt.ID, RowRelative:=False 
       'Font Color:=pjBlack 
       FontEx CellColor:=pjYellow 
      Case "Green" 
       SelectRow Row:=tskt.ID, RowRelative:=False 
       'Font Color:=pjBlack 
       FontEx CellColor:=pjWhite 
      Case "Red" 
       SelectRow Row:=tskt.ID, RowRelative:=False 
       'Font Color:=pjRed 
       FontEx CellColor:=pjRed 
      Case "Overdue" 
       SelectRow Row:=tskt.ID, RowRelative:=False 
       Font Color:=pjWhite 
       Font32Ex CellColor:=192 
     End Select 
    End If 
    End If 
    End If 
    End If 
Next tskt 

End Sub 

ответ

0

Я нашел, что при работе с интерфейсом гораздо быстрее использовать встроенные фильтры ms project.

Имейте столбцы добавления проекта для внешней задачи, сводки и текста1. Затем используйте Application.SetAutoFilter для фильтрации Summary = yes, ExternalTak = Yes, затем отфильтруйте каждый Text1, SelectAll и установите форматирование. Что-то вроде этого:

Sub Change_Color_By_Task_Status() 

    'Add columns to filter 
    TableEditEx Name:="&Entry", TaskTable:=True, NewName:="", NewFieldName:="Text1", ColumnPosition:=0 
    TableApply Name:="&Entry" 
    TableEditEx Name:="&Entry", TaskTable:=True, NewName:="", NewFieldName:="External Task", Title:="", ColumnPosition:=0 
    TableApply Name:="&Entry" 
    TableEditEx Name:="&Entry", TaskTable:=True, NewName:="", NewFieldName:="Summary", Title:="", ColumnPosition:=0 
    TableApply Name:="&Entry" 

    'Filter out summaries and externals 
    SetAutoFilter FieldName:="External Task", FilterType:=pjAutoFilterFlagNo 
    SetAutoFilter FieldName:="Summary", FilterType:=pjAutoFilterFlagNo 

    'Filter by Text1 
    'for "Complete" 
    SetAutoFilter FieldName:="Text1", FilterType:=pjAutoFilterCustom,  Test1:="equals", criteria1:="Complete" 
    SelectAll 
    '[Apply complete formatting] 
    SetAutoFilter FieldName:="Text1", FilterType:=pjAutoFilterClear 

    '... repeat for the other Text1 values 

    'clear filters 
    SetAutoFilter FieldName:="External Task", FilterType:=pjAutoFilterClear 
    SetAutoFilter FieldName:="Summary", FilterType:=pjAutoFilterClear 

    'Remove columns 
    SelectTaskColumn Column:="Text1" 
    ColumnDelete 
    SelectTaskColumn Column:="Summary" 
    ColumnDelete 
    SelectTaskColumn Column:="External Task" 
    ColumnDelete 
End Sub 

Надеется, что это ускоряет его

+0

Спасибо KainC, пожалуйста, дайте мне бы более подробные инструкции о том, как сделать это? Я начинающий Project vba, поэтому я не могу вас хорошо поймать. –

+0

Я добавил схему того, как это будет выглядеть: – kainC

+0

KainC, где я должен поместить коды orignal, пожалуйста? после фильтров из резюме и внешних? –

Смежные вопросы