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

从文档中我似乎找不到任何关于如何做到这一点的信息。我的问题基本上已经解决了。我需要max WBS level 1值作为一个整数，然后循环遍历它的所有level2子任务/摘要，并将它们的一些值放入一个数组中

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

任何帮助或指导都将不胜感激，微软项目文档非常糟糕，互联网上没有太多关于这方面的信息

我不想这样做：

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

---

我不知道你说的“我需要最高WBS 1级”是什么意思。这不是你项目的第一项任务吗？。。i、 e.

ActiveProject.Tasks.Item（1）

对于数组中的2级任务：查看任务的

.outlineLevel

属性。此属性告诉您任务是否为WBS级别1、2、3等

有关详细信息，请参阅

至于“用正确的行/列调暗我的数组”：你可以使用一个数组，或者先计算它的大小，或者在找到更多元素时不断调整它的大小；我建议的另一种方法是使用可以添加元素的数据结构。我的首选是

集合

数据类型。它是内置的，易于使用，但也有其他可能更适合您的情况

我认为这个片段应该满足您的要求：

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

---

考虑使用

t.OutlineLevel

对它们进行排序

不幸的是，您必须循环才能解决问题。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

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

当您需要计算2级WBS下的子任务时，最简单的方法是分解成一个单独的函数来保持逻辑的清晰。它从给定的任务开始，然后向下，比较每个后续任务的WBS“前缀”——这意味着如果您在WBS 1.1下寻找子任务，那么当您看到WBS 1.1.1和1.1.2时，您需要真正比较每个任务的“1.1”部分。计数，直到子任务用完为止

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

以下是整个测试模块：

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

---

此代码查找WBS最高的任务（例如，WBS代码第一部分的最大值），并根据计划的大纲结构计算其子任务数

Sub GetMaxWBSTaskInfo()

    Dim MaxWBS As Integer
    Dim tsk As Task
    Dim MaxWbsTask As Task
    Dim NumSubtasks As Integer

    ' expand all subprojects so loop goes through all subproject tasks
    Application.SelectAll
    Application.OutlineShowAllTasks
    Application.SelectBeginning

    For Each tsk In ActiveProject.Tasks
        If Split(tsk.WBS, ".")(0) > MaxWBS Then
            MaxWBS = Split(tsk.WBS, ".")(0)
            Set MaxWbsTask = tsk
        End If
    Next

    NumSubtasks = ChildCount(MaxWbsTask)
    Debug.Print "Max WBS level=" & MaxWBS, "Task: " & MaxWbsTask.Name, "# subtasks=" & NumSubtasks

End Sub

Function ChildCount(tsk As Task) As Integer
    Dim s As Task
    Dim NumTasks As Integer
    For Each s In tsk.OutlineChildren
        NumTasks = NumTasks + 1 + ChildCount(s)
    Next s
    ChildCount = NumTasks
End Function

---

你试过什么？你遇到了什么问题？请向我们展示您的代码以及您到目前为止所做的研究。您为什么不想这样做？循环执行任务非常快。我对MS Project一无所知，但从文档中看，它就像调用一样简单。@Comintern调用

。成功任务将使我从1移动到1.1，而不是2。或者如果有指定的前任和继任者（就像我工作的项目中的前任和继任者一样），这会让我兴奋不已。@RachelHettinger我只是希望有一些内置的函数或属性，或者一些可以减少我需要的代码量的东西。我的一些项目有多个子项目，所有的里程碑都存储在大纲级别1中。但谢谢你，这让我更亲近了。