如何在Excel中生成MS Project多筛选器的任务计数表格？

核心逻辑 #

• 先指定需要统计的筛选器名称列表
• 遍历每个筛选器，依次应用并统计任务行数
• 将筛选器名作为Excel列标题，对应计数填入下方单元格
• 统计完成后恢复MS Project原筛选器，避免干扰操作

完整VBA宏代码（MS Project中运行） #

Sub ExportFilterCountsToExcel()
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlWS As Object
    Dim filterNames As Variant
    Dim i As Integer
    Dim originalFilter As String
    Dim rowCount As Integer
    
    ' --------------------------
    ' 自定义要统计的筛选器名称列表
    filterNames = Array("filter 1", "filter 2", "filter 3") ' 替换为你的目标筛选器名称
    ' --------------------------
    
    ' 保存当前筛选器，统计完成后恢复
    originalFilter = ActiveProject.CurrentFilter
    
    On Error Resume Next
    ' 调用已打开的Excel，若未打开则新建
    Set xlApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
    End If
    On Error GoTo 0
    
    ' 新建Excel工作簿和工作表
    Set xlWB = xlApp.Workbooks.Add
    Set xlWS = xlWB.Sheets(1)
    xlWS.Name = "筛选器任务计数"
    
    ' 写入列标题并加粗
    For i = LBound(filterNames) To UBound(filterNames)
        xlWS.Cells(1, i + 1).Value = filterNames(i)
        xlWS.Cells(1, i + 1).Font.Bold = True
    Next i
    
    ' 遍历筛选器统计任务行数
    For i = LBound(filterNames) To UBound(filterNames)
        On Error Resume Next
        ' 应用目标筛选器
        ApplyFilter Name:=filterNames(i)
        If Err.Number <> 0 Then
            xlWS.Cells(2, i + 1).Value = "筛选器不存在"
            Err.Clear
            GoTo NextFilter
        End If
        On Error GoTo 0
        
        ' 全选任务并统计数量
        SelectAll
        rowCount = ActiveSelection.Tasks.Count
        
        ' 将计数写入Excel对应单元格
        xlWS.Cells(2, i + 1).Value = rowCount
        
NextFilter:
    Next i
    
    ' 恢复MS Project原筛选器
    ApplyFilter Name:=originalFilter
    
    ' 自动调整Excel列宽
    xlWS.UsedRange.Columns.AutoFit
    
    ' 释放对象避免内存泄漏
    Set xlWS = Nothing
    Set xlWB = Nothing
    Set xlApp = Nothing
    
    MsgBox "统计完成，结果已导出到Excel！", vbInformation
End Sub

代码说明 #

• 自定义筛选器：修改filterNames = Array(...)中的内容，确保筛选器名称与MS Project中完全匹配（区分大小写）
• 错误处理：若指定的筛选器不存在，Excel中会标记「筛选器不存在」，避免宏崩溃
• 还原操作：统计完成后自动切换回用户原本使用的筛选器，不影响后续Project操作
• 格式优化：自动加粗标题、调整列宽，让输出表格更易读

使用步骤 #

1. 打开目标MS Project文件
2. 按下Alt + F11打开VBA编辑器
3. 右键项目→插入→模块，将上述代码粘贴到模块中
4. 修改filterNames数组为你的目标筛选器名称
5. 按下F5或点击运行按钮执行宏

内容的提问来源于stack exchange，提问作者Waqas Mahmood