如何用VBA提取MS Project中资源每月工作可用时长？

要提取资源每月的可用工作时长，核心是利用MS Project对象模型中的资源日历（Resource.Calendar）和可用性集合（Resource.Availability），以下是具体实现方法和代码示例：

方法1：基于资源日历计算每月可用工时 #

通过资源的日历对象，调用WorkingHours方法计算指定月份的总工作时长，该方法会自动考虑日历的工作日设置、例外日期等规则。

示例代码（扩展你的现有代码） #

Sub ExtractResourceMonthlyAvailability()
    Dim ws As Worksheet
    Dim res As Resource
    Dim ligne As Integer
    Dim startDate As Date, endDate As Date
    Dim currentMonthStart As Date, currentMonthEnd As Date
    Dim totalMonths As Integer, i As Integer
    
    ' 设置输出工作表
    Set ws = Sheets(1)
    ws.Cells.Clear
    
    ' 写入表头：资源名称、组，以及各月份列
    ws.Cells(1, 1).Value = "Nom"
    ws.Cells(1, 2).Value = "Groupe"
    
    ' 定义时间范围（可根据项目实际调整）
    startDate = ActiveProject.Start
    endDate = ActiveProject.Finish
    
    ' 计算总月份数并生成月份表头
    totalMonths = DateDiff("m", startDate, endDate) + 1
    currentMonthStart = DateSerial(Year(startDate), Month(startDate), 1)
    For i = 1 To totalMonths
        ws.Cells(1, 2 + i).Value = Format(currentMonthStart, "yyyy-mm")
        currentMonthStart = DateAdd("m", 1, currentMonthStart)
    Next i
    
    ligne = 2
    ' 遍历每个资源
    For Each res In ActiveProject.Resources
        If Not res Is Nothing And Trim(res.Code) <> "" Then
            ' 写入资源基本信息
            ws.Cells(ligne, 1).Value = res.Name
            ws.Cells(ligne, 2).Value = res.Group
            
            ' 计算每个月的可用工时
            currentMonthStart = DateSerial(Year(startDate), Month(startDate), 1)
            For i = 1 To totalMonths
                ' 获取当月最后一天
                currentMonthEnd = DateSerial(Year(currentMonthStart), Month(currentMonthStart) + 1, 0)
                ' 确保不超过项目结束日期
                If currentMonthEnd > endDate Then currentMonthEnd = endDate
                
                ' 计算该月可用工时（单位：小时）
                ws.Cells(ligne, 2 + i).Value = res.Calendar.WorkingHours(currentMonthStart, currentMonthEnd)
                
                currentMonthStart = DateAdd("m", 1, currentMonthStart)
            Next i
            
            ligne = ligne + 1
        End If
    Next res
End Sub

方法2：基于Resource.Availability集合 #

如果资源有自定义的可用性时间段（比如部分时间可用、阶段性可用），可以直接遍历Resource.Availability集合，将每个时间段拆分到对应月份计算时长：

核心代码片段 #

' 遍历资源的可用性时间段
For Each avail In res.Availability
    Dim availStart As Date, availFinish As Date
    availStart = avail.Start
    availFinish = avail.Finish
    
    ' 拆分时间段到每个月
    Dim monthStart As Date, monthEnd As Date
    monthStart = DateSerial(Year(availStart), Month(availStart), 1)
    Do While monthStart <= availFinish
        monthEnd = DateSerial(Year(monthStart), Month(monthStart) + 1, 0)
        If monthEnd > availFinish Then monthEnd = availFinish
        If monthStart < availStart Then monthStart = availStart
        
        ' 计算该时间段在当月的时长（小时）
        Dim monthlyHours As Double
        monthlyHours = DateDiff("n", monthStart, monthEnd) / 60 * avail.Available
        
        ' 将结果写入对应月份列（需自行匹配月份列的位置）
        ' ws.Cells(ligne, colIndex).Value = monthlyHours
        
        monthStart = DateAdd("m", 1, monthStart)
    Loop
Next avail

关键说明 #

• WorkingHours方法返回的是总工作小时数，已排除非工作日和例外日期。
• Availability.Available属性是资源在该时间段的可用比例（比如0.5表示50%可用），需乘以实际时长得到有效可用工时。
• 若资源使用的是项目基准日历，res.Calendar会继承基准日历的设置；若有单独的资源日历，则优先使用资源自身的日历。

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