獲取2組日期之間的日期，不包括非作業日

我正在使用一個函式來獲取兩組日期之間的日期，它可以作業，但是我只想獲取作業日的日期：

已嘗試合并 Application.WorksheetFunction.WorkDay 但我仍然在日期集中得到非作業日 - 有什么建議嗎？

原始功能：

Public Function getDates(ByVal StartDate As Date, ByVal EndDate As Date) As Variant

    Dim varDates()      As Date
    Dim lngDateCounter  As Long

    ReDim varDates(0 To CLng(EndDate) - CLng(StartDate))

    For lngDateCounter = LBound(varDates) To UBound(varDates)
        varDates(lngDateCounter) = CDate(StartDate)
        StartDate = CDate(CDbl(StartDate)   1)
    Next lngDateCounter

    getDates = varDates

End Function

排除非作業日的試用：

Public Function getDates(ByVal StartDate As Date, ByVal EndDate As Date) As Variant

    Dim varDates()      As Date
    Dim lngDateCounter  As Long

    ReDim varDates(0 To CLng(EndDate) - CLng(StartDate))

    For lngDateCounter = LBound(varDates) To UBound(varDates)
        varDates(lngDateCounter) = CDate(Application.WorksheetFunction.WorkDay(StartDate, 0))
        StartDate = CDate(CDbl(StartDate)   1)
    Next lngDateCounter

    getDates = varDates

End Function

uj5u.com熱心網友回復：

試試這個：

假期（固定和浮動）的集合使用硬編碼日期進行初始化，但如果從作業表或表格中讀取日期會更好。

Private mFixedHolidays As Collection
Private mFloatingHolidays As Collection

Public Function getDates(ByVal StartDate As Date, ByVal EndDate As Date) As Variant

    Dim varDates()      As Date
    Dim lngDateCounter  As Long

    ReDim varDates(0 To CLng(EndDate) - CLng(StartDate))
    
    Dim dTotalWorkdays As Long
    dTotalWorkdays = 0
    
    Dim dDate As Date
    
    dDate = StartDate
    For lngDateCounter = LBound(varDates) To UBound(varDates)
        
        If Not (IsWeekendDay(dDate) Or IsFixedHoliday(dDate) Or IsFloatingHoliday(dDate)) Then
            varDates(dTotalWorkdays) = dDate
            dTotalWorkdays = dTotalWorkdays   1
        End If
        
        dDate = CDate(CDbl(dDate)   1)
        
    Next lngDateCounter

    ReDim Preserve varDates(dTotalWorkdays - 1)
    
    getDates = varDates

End Function

Private Function IsWeekendDay(ByVal dateOfInterest As Date) As Boolean
    IsWeekendDay = _
         Weekday(dateOfInterest) = VbDayOfWeek.vbSaturday _
              Or Weekday(dateOfInterest) = VbDayOfWeek.vbSunday
End Function

Private Function IsFixedHoliday(ByVal dateOfInterest As Date) As Boolean

    Dim result As Boolean
    result = False
    
    If mFixedHolidays Is Nothing Then
        Set mFixedHolidays = New Collection
        'Year portion of dates will be ignored
        With mFixedHolidays
            .Add "7/4/2022"
            .Add "12/25/2022"
            .Add "1/1/2022"
            'Add other fixed date holidays
        End With
    End If
    
    Dim fixedDate As Date
    Dim dateToken As Variant
    For Each dateToken In mFixedHolidays
        
        fixedDate = DateValue(dateToken)
        
        If Month(fixedDate) = Month(dateOfInterest) And Day(fixedDate) = Day(dateOfInterest) Then
            result = True
            Exit For
        End If
    Next
    
    IsFixedHoliday = result
    
End Function

Private Function IsFloatingHoliday(ByVal dateOfInterest As Date) As Boolean

    Dim result As Boolean
    result = False
    
    If mFloatingHolidays Is Nothing Then
        Set mFloatingHolidays = New Collection
        With mFloatingHolidays
            .Add "5/30/2022" 'Memorial Day
            'Add other floating date holidays
        End With
    End If
    
    Dim floatingDate As Date
    Dim dateToken As Variant
    For Each dateToken In mFloatingHolidays
        
        floatingDate = DateValue(dateToken)
        
        If floatingDate = dateOfInterest Then
            result = True
            Exit For
        End If
    Next
    
    IsFloatingHoliday = result
    
End Function

標籤：vba 功能 日期

上一篇：僅在已設定時才包含range.address的公式

下一篇：管理類內的集合