找到最大 1 级 WBS 并将所有 2 级 WBS 放入数组的简单方法？
Simple way to find max level 1 WBS and put all Level 2 WBS into array?
我似乎无法从文档中找到任何有关如何执行此操作的信息。我的问题基本上已经说明了一切。我需要最大 WBS 级别 1 值作为整数，然后遍历其所有级别 2 subtasks/summaries 并将它们的几个值放入数组中。
如果我可以在迭代之前获得属于该摘要的子任务的数量，那么我可以用正确的 rows/columns 使我的数组变暗，而不必在事后转置它，这也会很方便。
如有任何帮助或指导，我们将不胜感激，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
我不确定 "I need the max WBS level 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
至于"dim my array with the correct rows/columns"：虽然您可以使用数组并首先计算出它的大小，或者在找到更多元素时继续调整它的大小；我建议的另一种方法是使用可以添加元素的数据结构。我的首选是 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
考虑使用 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
当您需要计算 2 级 WBS 下的子任务时，最简单的方法是分解成一个单独的函数以保持逻辑清晰。它的作用是从给定的任务开始并向下工作，比较每个后续任务的 WBS "prefix"——这意味着如果您正在寻找 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
此代码查找具有最高 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
我似乎无法从文档中找到任何有关如何执行此操作的信息。我的问题基本上已经说明了一切。我需要最大 WBS 级别 1 值作为整数，然后遍历其所有级别 2 subtasks/summaries 并将它们的几个值放入数组中。
如果我可以在迭代之前获得属于该摘要的子任务的数量，那么我可以用正确的 rows/columns 使我的数组变暗，而不必在事后转置它，这也会很方便。
如有任何帮助或指导，我们将不胜感激，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
我不确定 "I need the max WBS level 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
至于"dim my array with the correct rows/columns"：虽然您可以使用数组并首先计算出它的大小，或者在找到更多元素时继续调整它的大小；我建议的另一种方法是使用可以添加元素的数据结构。我的首选是 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
考虑使用 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
当您需要计算 2 级 WBS 下的子任务时，最简单的方法是分解成一个单独的函数以保持逻辑清晰。它的作用是从给定的任务开始并向下工作，比较每个后续任务的 WBS "prefix"——这意味着如果您正在寻找 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
此代码查找具有最高 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