Определение конкретных ресурсов, которые перераспределены в MS Project с использованием шкалы времени

#vba #ms-project

#vba #ms-project

Вопрос:

У меня есть несколько ресурсов (учащиеся, фасилитаторы и комнаты), выделенных для задач (учебных сессий), и я хочу определить, какие из них зарезервированы дважды, а затем добавить их в текстовый столбец.

Я использую метод TimeScale и в настоящее время пытаюсь рассчитать двойное резервирование, предполагая, что любой ресурс, у которого больше времени, чем продолжительность сеанса, выделенного им в течение заданной даты начала и окончания для этого сеанса, должен быть зарезервирован дважды.

Однако я не могу понять, как определить общее количество времени, которое им было назначено. Атрибут pjTimeScale, похоже, не возвращает то, что мне нужно. Использование pjTimescaleHours наиболее близко к фактическому значению, которое должно быть возвращено.

Чего мне не хватает? или есть лучший подход?

 Sub Overallocations()
'T.Text19 is the Overallocation column
'Identify the overallocations and the source ID
Dim T As Task
Dim R As Resource
Dim tsvs As TimeScaleValues

Dim asn As Assignment

For Each T In ActiveProject.Tasks
T.Text19 = ""
Next T

'Start the allocation of Rooms process
For Each T In ActiveProject.Tasks

i = 0

Application.StatusBar = "Checking Session No." amp; T.ID
'Checks to see if the task is a valid Module session and if it has been 
confirmed. Skips if not a session or if its a confirmed session
If Left(T.Name, 1) <> "M" Then
    GoTo SkipT
End If

For Each R In T.Resources

    Set tsvs = R.TimeScaleData(T.Start, T.Finish, pjResourceTimescaledWork, 
pjTimescaleHours)
    Duration = (T.Finish - T.Start) * 60 * 24


    If tsvs(1).Value > Duration   1 Then  'THIS IS WHAT IS NOT WORKING
        If T.Text19 = "" Then
            T.Text19 = R.Name
        Else
            T.Text19 = T.Text19 amp; ", " amp; R.Name
        End If
    End If
Next R

SkipT:
Next T 'Next Task

MsgBox "The identification of overallocation has been completed.", 
vbInformation, "Resource Overallocation Complete"

End Sub
  

Ответ №1:

У меня есть несколько ресурсов (учащиеся, фасилитаторы и комнаты), выделенных для задач (учебных сессий), и я хочу определить, какие из них зарезервированы дважды…

Другими словами, необходимо определить учащихся, фасилитаторов и помещения, которые назначены для перекрывающихся учебных сессий.

Хотя это можно сделать с помощью TimeScaleData метода, гораздо более простым подходом является поиск перекрывающихся сеансов. Существует четыре сценария, в которых учебные сеансы накладываются друг на друга:

  • Класс B запускается перед классом A и завершается, когда класс A все еще выполняется.
  • Класс B запускается во время выполнения класса A и завершается после класса A.
  • Класс B запускается и завершается во время выполнения класса A.
  • Класс B начинается перед классом A и заканчивается после класса A.

Все четыре сценария могут быть идентифицированы с помощью общего выражения: Class B starts before Class A ends and Class B ends after Class A starts ; смотрите диаграмму ниже.

графическое объяснение того, как два временных фрейма могут перекрываться (или нет)

Вот ваш код, адаптированный для этого метода:

 Sub IdentifyOverlappingAssignments()

Dim T As Task
Dim R As Resource

For Each T In ActiveProject.Tasks

    Application.StatusBar = "Checking Session No." amp; T.ID

    T.Text19 = vbNullString

    'Checks to see if the task is a valid Module session and if it has been confirmed.
    If Left(T.Name, 1) = "M" Then

        For Each R In T.Resources

            ' check to see if this resource is assigned to another task
            ' at all during the duration of this task
            Dim asn As Assignment
            For Each asn In R.Assignments
                If asn.Task.UniqueID <> T.UniqueID Then
                    ' do the tasks overlap?
                    If asn.Task.Finish > T.Start And asn.Task.Start < T.Finish Then
                        If T.Text19 = "" Then
                            T.Text19 = R.Name amp; " (" amp; asn.Task.ID amp; ")"
                        Else
                            T.Text19 = T.Text19 amp; ", " amp; R.Name amp; " (" amp; asn.Task.ID amp; ")"
                        End If
                    End If
                End If
            Next asn

        Next R
    End If
Next T

MsgBox "The identification of overallocation has been completed." _
    , vbInformation, "Resource Overallocation Complete"

End Sub
  

Примечание: использование TimeScaleData в этом случае проблематично по разным причинам, в том числе: 1) ресурсы могут быть назначены с использованием 50% и не будут идентифицированы как зарезервированные дважды, потому что они не будут перераспределены, 2) если занятия начинаются в течение получаса (например, с 10: 30 до 12:00), вам нужно будет получить значения шкалы времени с точностью до минуты, потому что использование pjTimescaleHours вернет полный час (например, время, указанное в значения шкалы времени начнутся в 10:00 утра), и это простая ошибка, которую можно внести в ваш код.

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

1. Кстати, логика, используемая для поиска перекрывающихся резервирований ресурсов, также работает для определения задач, которые попадают в заданный диапазон. Например, используйте его, чтобы «перечислить все задачи, над которыми выполняется работа в течение следующих 90 дней».

Ответ №2:

Две вещи, одно указание на код и один вопрос.

  1. Если вы за … просматривая коллекцию задач, не забудьте поместить If .. Затем просто внутри нее, как эта, чтобы получить пустые строки. PMS ЛЮБЯТ пустые строки, и они выдадут ваш код с ошибкой. Я также делаю это для ресурсов, потому что иногда они также помещают туда пустые строки.

  2. Могу ли я спросить, почему вы делаете это вместо того, чтобы использовать встроенную функциональность «Overallocated» в Project? Если ресурсу назначено более 1 часа работы в любой данный час, то этот ресурс автоматически будет помечен как таковой, как и любая задача, для которой они назначены. Это классный код, но в нем не должно быть необходимости, если я чего-то не упускаю.

Код:

 Sub Foo()
Dim T As Task
Dim R As Resource
    For Each T In ActiveProject.Tasks
        If Not (T Is Nothing) Then
            'Task stuff
            For Each R In T.Resources
                If Not (R Is Nothing) Then
                    Resource Stuff
                End If
            Next R
        End If
    Next T
End Sub