获取两组日期之间的日期，不包括非工作日

Question

我正在使用一个函数来获取两组日期之间的日期，它有效，但是我只想获取工作日的日期：

尝试过合并 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

Answer 1

试一试：

假期（固定和浮动）的集合是用硬编码日期初始化的，但如果从工作表或 table 中读取日期会更好。

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

获取两组日期之间的日期，不包括非工作日

Get dates between 2 sets of dates excluding non workdays

vba

date

function