查找最大1级WBS并将所有2级WBS放入阵列的简单方法?

时间:2018-08-08 21:08:26

标签: vba ms-project

我似乎无法从文档中找到任何有关如何执行此操作的信息。我的问题基本上已经解决了。我需要将最大WBS级别1值作为整数,然后遍历所有级别2子任务/摘要并将它们的几个值放入数组中。

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

任何帮助或指导将不胜感激,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

4 个答案:

答案 0 :(得分:2)

不幸的是,您将不得不循环找出问题。 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

答案 1 :(得分:1)

我不确定您所说的“我需要最高WBS 1级”是什么意思。这不只是您项目中的第一项任务吗?..即ActiveProject.Tasks.Item(1)

关于数组中的第2级任务:看一下任务的.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

答案 2 :(得分:1)

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

答案 3 :(得分:0)

此代码查找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