找到最大级别1的WBS并将所有级别2的WBS放入数组的简单方法？

Question

我似乎在文档中找不到任何关于我可以如何做到这一点的东西。我的问题基本上是应有尽有的。我需要一个整数形式的最大WBS level 1值，然后循环遍历它的所有level2子任务/摘要，并将它们的几个值放入一个数组中。

如果我可以在迭代之前获得属于该摘要的子任务的数量，这样我就可以用正确的行/列调整我的数组，而不必在事后转置它，这也是很方便的。

任何帮助或指导都将不胜感激，MS Project文档很糟糕，而且互联网上也没有太多关于这方面的信息。

我不想这样做：

Dim TopVal As Integer
For Each t in ActiveProject.Tasks
   Dim tVal As Integer
   tVal = t.WBS.Split("."c)(0)
   If  tVal > TopVal Then TopVal = tVal
Next t

Answer 1

不幸的是，你将不得不通过循环来解决问题。MS Project不允许您在不循环所有内容的情况下将一组字段(就像所有的WBS)拉入到一个数组中。对于这个问题，您需要确定两个不同的信息:您正在处理的WBS级别和给定WBS下的子任务级别。

在主程序级别，您需要遍历所有任务并确定每个任务的WBS级别。一旦你达到了你想要的级别，你就可以确定子任务的数量了。

Private Sub test()
    With ThisProject
        Dim i As Long
        For i = 1 To .Tasks.count
            Dim subWBSCount As Long
            If .Tasks.Item(i).OutlineLevel = 2 Then
                subWBSCount = GetSubWBSCount(.Tasks.Item(i).wbs, i)
                Debug.Print "At level 2 (" & .Tasks.Item(i).wbs & _
                            ") there are " & subWBSCount & " sub tasks"
                '-----------------------------------------------
                '    you can properly dimension your array here,
                '    then fill it with the sub-task information
                '    as needed
                '-----------------------------------------------
            End If
        Next i
    End With
End Sub

当您需要计算2级WBS下的子任务时，最简单的方法是使用单独的函数来保持逻辑清晰。它的作用是从给定的任务开始并向下工作，比较每个后续任务的WBS“前缀”--意思是如果您在WBS 1.1下寻找子任务，那么当您看到WBS 1.1.1和1.1.2时，您需要真正比较每个任务的"1.1“部分。计算到用完所有的子任务。

Private Function GetSubWBSCount(ByVal topWBS As String, ByVal wbsIndex As Long) As Long
    '--- loop to find the given WBS, then determine how many
    '    sub tasks lie under that WBS
    With ThisProject
        Dim j As Long
        Dim count As Long
        For j = (wbsIndex + 1) To .Tasks.count
            Dim lastDotPos As Long
            lastDotPos = InStrRev(.Tasks.Item(j).wbs, _
                                  ".", , vbTextCompare)
            Dim wbsPrefix As String
            wbsPrefix = Left$(.Tasks.Item(j).wbs, _
                              lastDotPos - 1)
            If wbsPrefix = topWBS Then
                count = count + 1
                '--- check for the edge case where this is
                '    the very last task, and so our count is
                '    finished
                If j = .Tasks.count Then
                    GetSubWBSCount = count
                    Exit Function
                End If
            Else
                '--- once we run out of sub-wbs tasks that
                '    match, we're done
                GetSubWBSCount = count
                Exit Function
            End If
        Next j
    End With
End Function

下面是整个测试模块：

Option Explicit

Private Sub test()
    With ThisProject
        Dim i As Long
        For i = 1 To .Tasks.count
            Dim subWBSCount As Long
            If .Tasks.Item(i).OutlineLevel = 2 Then
                subWBSCount = GetSubWBSCount(.Tasks.Item(i).wbs, i)
                Debug.Print "At level 2 (" & .Tasks.Item(i).wbs & _
                            ") there are " & subWBSCount & " sub tasks"
                '-----------------------------------------------
                '    you can properly dimension your array here,
                '    then fill it with the sub-task information
                '    as needed
                '-----------------------------------------------
            End If
        Next i
    End With
End Sub

Private Function GetSubWBSCount(ByVal topWBS As String, ByVal wbsIndex As Long) As Long
    '--- loop to find the given WBS, then determine how many
    '    sub tasks lie under that WBS
    With ThisProject
        Dim j As Long
        Dim count As Long
        For j = (wbsIndex + 1) To .Tasks.count
            Dim lastDotPos As Long
            lastDotPos = InStrRev(.Tasks.Item(j).wbs, _
                                  ".", , vbTextCompare)
            Dim wbsPrefix As String
            wbsPrefix = Left$(.Tasks.Item(j).wbs, _
                              lastDotPos - 1)
            If wbsPrefix = topWBS Then
                count = count + 1
                '--- check for the edge case where this is
                '    the very last task, and so our count is
                '    finished
                If j = .Tasks.count Then
                    GetSubWBSCount = count
                    Exit Function
                End If
            Else
                '--- once we run out of sub-wbs tasks that
                '    match, we're done
                GetSubWBSCount = count
                Exit Function
            End If
        Next j
    End With
End Function

Answer 2

我不确定你所说的“我需要最大的WBS级别1”是什么意思。这难道不是你项目中的第一个任务吗？即ActiveProject.Tasks.Item(1)

对于数组中的第二级任务:查看任务的.outlineLevel属性。此属性告诉您任务是否为WBS级别1、2、3等。

有关更多详细信息，请参阅https://msdn.microsoft.com/en-us/vba/project-vba/articles/task-outlinelevel-property-project

至于“用正确的行/列调暗我的数组”：虽然你可以使用一个数组，然后先计算出它的大小，或者随着你找到更多的元素而不断地调整它的大小；我建议的另一种方法是使用一个可以添加元素的数据结构。我的首选是Collection数据类型。它是内置的，易于使用，但也有其他可用的可能更适合您的情况。

我认为这段代码应该能满足您的要求：

Function getLevel2Tasks() As Collection
    Dim t As Task
    Dim level2Tasks As Collection
    Set level2Tasks = New Collection
    For Each t In ActiveProject.Tasks
       If t.outlineLevel = 2 Then
            level2Tasks.Add Item:=t
        End If
    Next
    Set getLevel2Tasks = level2Tasks
End Function

Answer 3

考虑使用t.OutlineLevel对它们进行排序