計算工作天數

时　间:2008-10-14 15:25:19
作　者:   ID：379  城市：东莞
摘　要:計算工作天數
正　文:

Public Function BusinessDays(dteStartDate As Date, dteEndDate As Date) As Long

'使用方法: BusinessDays(開始日期,結束日期)

    Dim lngYear As Long
    Dim lngEYear As Long
    Dim dteStart As Date, dteEnd As Date
    Dim dteCurr As Date
    Dim lngDay As Long
    Dim lngDiff As Long
    Dim lngACount As Long
    Dim dteLoop As Variant
    Dim blnHol As Boolean
    Dim dteHoliday() As Date
    Dim lngCount As Long, lngTotal As Long
    Dim lngThanks As Long
   
    dteStart = dteStartDate
    dteEnd = dteEndDate
   
    lngYear = DatePart("yyyy", dteStart)
    lngEYear = DatePart("yyyy", dteEnd)
   
    If lngYear <> lngEYear Then
        lngDiff = (((lngEYear - lngYear) + 1) * 7) - 1
        ReDim dteHoliday(lngDiff)
    Else
        ReDim dteHoliday(6)
    End If
   
    lngACount = -1
   
    For lngCount = lngYear To lngEYear
        lngACount = lngACount + 1
        'July Fourth
        dteHoliday(lngACount) = DateSerial(lngCount, 7, 4)
   
        lngACount = lngACount + 1
        'Christmas
        dteHoliday(lngACount) = DateSerial(lngCount, 12, 25)
   
        lngACount = lngACount + 1
        'New Years
        dteHoliday(lngACount) = DateSerial(lngCount, 1, 1)
   
        lngACount = lngACount + 1
        'Thanksgiving - 4th Thursday of November
        lngDay = 1
        lngThanks = 0
        Do
            If Weekday(DateSerial(lngCount, 11, lngDay)) = 5 Then
                lngThanks = lngThanks + 1
            End If
            lngDay = lngDay + 1
        Loop Until lngThanks = 4
       
        dteHoliday(lngACount) = DateSerial(lngCount, 11, lngDay)
       
        lngACount = lngACount + 1
        'Memorial Day - Last Monday of May
        lngDay = 31
        Do
            If Weekday(DateSerial(lngCount, 5, lngDay)) = 2 Then
                dteHoliday(lngACount) = DateSerial(lngCount, 5, lngDay)
            Else
                lngDay = lngDay - 1
            End If
        Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 5, 1)
   
        lngACount = lngACount + 1
        'Labor Day - First Monday of Septemeber
        lngDay = 1
        Do
            If Weekday(DateSerial(lngCount, 9, lngDay)) = 2 Then
                dteHoliday(lngACount) = DateSerial(lngCount, 9, lngDay)
            Else
                lngDay = lngDay + 1
            End If
        Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 9, 1)
        'MsgBox dteHoliday(5)
       
        lngACount = lngACount + 1
       'Easter
        lngDay = (((255 - 11 * (lngCount Mod 19)) - 21) Mod 30) + 21
   
        dteHoliday(lngACount) = DateSerial(lngCount, 3, 1) + lngDay + _
                (lngDay > 48) + 6 - ((lngCount + lngCount \ 4 + _
                lngDay + (lngDay > 48) + 1) Mod 7)
    Next
       
         
     For lngCount = 1 To DateDiff("d", dteStart, dteEnd)
        dteCurr = (dteStart + lngCount)
        If (Weekday(dteCurr) <> 1) And (Weekday(dteCurr) <> 7) Then
            blnHol = False
            For dteLoop = 0 To UBound(dteHoliday)
            'MsgBox dteHoliday(dteLoop) & "  " & dteLoop
                If (dteHoliday(dteLoop) = dteCurr) Then
                 blnHol = True
                End If
            Next dteLoop
            If blnHol = False Then
                lngTotal = lngTotal + 1
                'MsgBox dteCurr
            End If
        End If
    Next lngCount

BusinessDays = lngTotal
      
End Function