Différence de date, à l'exclusion de certaines heures et dates

Question

Je cherche un moyen de déterminer la différence entre deux dates. Une instruction SQL DATEDIFF normale ne le coupera pas car j'ai besoin d'exclure les heures et les jours non travaillés, à savoir les week-ends et entre 16h00 et 7h00.

Quelque chose de similaire à la fonction NETWORKDAYS dans Excel.

Je suis en train de coder une feuille de calcul Excel. En utilisant VBA, connectez-vous à un serveur SQL pour extraire des données.

Answer 1

Voici un exemple de code que j'ai obtenu du réseau et modifié pour travailler avec un tableau de dates que j'ai stocké dans une table d'accès. Je suis sûr que vous pourriez le changer à nouveau pour pointer à une gamme dans une feuille de calcul etc, mais l'idée de base fonctionne un régal

Option Compare Database 
Option Explicit 

Public Function dhCountWorkdaysA(ByVal dtmStart As Date, ByVal dtmEnd As Date, _ 
Optional adtmDates As Variant = Empty) _ 
As Integer 

    ' Count the business days (not counting weekends/holidays) in 
    ' a given date range. 

    ' Modified from code in 
    ' "Visual Basic Language Developer's Handbook" 
    ' by Ken Getz and Mike Gilbert 
    ' Copyright 2000; Sybex, Inc. All rights reserved. 

    ' Requires: 
    ' SkipHolidays 
    ' CountHolidays 
    ' IsWeekend 

    ' In: 
    ' dtmStart: 
    '  Date specifying the start of the range (inclusive) 
    ' dtmEnd: 
    '  Date specifying the end of the range (inclusive) 
    '  (dates will be swapped if out of order) 
    ' adtmDates (Optional): 
    '  Array containing holiday dates. Can also be a single 
    '  date value. 
    ' Out: 
    ' Return Value: 
    '  Number of working days (not counting weekends and optionally, holidays) 
    '  in the specified range. 
    ' Example: 
    ' Debug.Print dhCountWorkdaysA(#7/2/2000#, #7/5/2000#, _ 
    ' Array(#1/1/2000#, #7/4/2000#)) 
    ' 
    ' returns 2, because 7/2/2000 is Sunday, 7/4/2000 is a holiday, 
    ' leaving 7/3 and 7/5 as workdays. 

    Dim intDays As Integer 
    Dim dtmTemp As Date 
    Dim intSubtract As Integer 

    ' Swap the dates if necessary.> 
    If dtmEnd < dtmStart Then 
     dtmTemp = dtmStart 
     dtmStart = dtmEnd 
     dtmEnd = dtmTemp 
    End If 

    ' Get the start and end dates to be weekdays. 
    dtmStart = SkipHolidaysA(adtmDates, dtmStart, 1) 
    dtmEnd = SkipHolidaysA(adtmDates, dtmEnd, -1) 
    If dtmStart > dtmEnd Then 
     ' Sorry, no Workdays to be had. Just return 0. 
     dhCountWorkdaysA = 0 
    Else 
     intDays = dtmEnd - dtmStart + 1 

     ' Subtract off weekend days. Do this by figuring out how 
     ' many calendar weeks there are between the dates, and 
     ' multiplying the difference by two (because there are two 
     ' weekend days for each week). That is, if the difference 
     ' is 0, the two days are in the same week. If the 
     ' difference is 1, then we have two weekend days. 
     intSubtract = (DateDiff("ww", dtmStart, dtmEnd) * 2) 

     ' The answer to our quest is all the weekdays, minus any 
     ' holidays found in the table. 
     intSubtract = intSubtract + _ 
     CountHolidaysA(adtmDates, dtmStart, dtmEnd) 

     dhCountWorkdaysA = intDays - intSubtract 
    End If 
End Function 
Private Function CountHolidaysA(_ 
adtmDates As Variant, _ 
dtmStart As Date, dtmEnd As Date) As Long 

    ' Count holidays between two end dates. 
    ' 
    ' Modified from code in 
    ' "Visual Basic Language Developer's Handbook" 
    ' by Ken Getz and Mike Gilbert 
    ' Copyright 2000; Sybex, Inc. All rights reserved. 

    ' Required by: 
    ' dhCountWorkdays 

    ' Requires: 
    ' IsWeekend 


    Dim lngItem As Long 
    Dim lngCount As Long 
    Dim blnFound As Long 
    Dim dtmTemp As Date 

    On Error GoTo HandleErr 
    lngCount = 0 
    Select Case VarType(adtmDates) 
     Case vbArray + vbDate, vbArray + vbVariant 
      ' You got an array of variants, or of dates. 
      ' Loop through, looking for non-weekend values 
      ' between the two endpoints. 
      For lngItem = LBound(adtmDates) To UBound(adtmDates) 
       dtmTemp = adtmDates(lngItem) 
       If dtmTemp >= dtmStart And dtmTemp <= dtmEnd Then 
        If Not IsWeekend(dtmTemp) Then 
         lngCount = lngCount + 1 
        End If 
       End If 
      Next lngItem 
     Case vbDate 
      ' You got one date. So see if it's a non-weekend 
      ' date between the two endpoints. 
      If adtmDates >= dtmStart And adtmDates <= dtmEnd Then 
       If Not IsWeekend(adtmDates) Then 
        lngCount = 1 
       End If 
      End If 
    End Select 

ExitHere: 
    CountHolidaysA = lngCount 
    Exit Function 

HandleErr: 
    ' No matter what the error, just 
    ' return without complaining. 
    ' The worst that could happen is that the code 
    ' include a holiday as a real day, even if 
    ' it's in the table. 
    Resume ExitHere 
End Function 


Public Function dhAddWorkDaysA(lngDays As Long, Optional dtmDate As Date = 0) 
'Optional adtmDates As Variant) As Date 
    ' Add the specified number of work days to the 
    ' specified date. 

    ' Modified from code in 
    ' "Visual Basic Language Developer's Handbook" 
    ' by Ken Getz and Mike Gilbert 
    ' Copyright 2000; Sybex, Inc. All rights reserved. 

    ' In: 
    ' lngDays: 
    '  Number of work days to add to the start date. 
    ' dtmDate: 
    '  date on which to start looking. 
    '  Use the current date, if none was specified. 
    ' adtmDates (Optional): 
    '  Array containing holiday dates. Can also be a single 
    '  date value, if that's what you want. 
    ' Out: 
    ' Return Value: 
    '  The date of the working day lngDays from the start, taking 
    '  into account weekends and holidays. 
    ' Example: 
    ' dhAddWorkDaysA(10, #2/9/2000#, Array(#2/16/2000#, #2/17/2000#)) 
    ' returns #2/25/2000#, which is the date 10 work days 
    ' after 2/9/2000, if you treat 2/16 and 2/17 as holidays 
    ' (just made-up holidays, for example purposes only). 

    ' Did the caller pass in a date? If not, use 
    ' the current date. 
    Dim lngCount As Long 
    Dim dtmTemp As Date 
    Dim adtmDates() As Variant 

    'loadup the adtmDates with all the records from the table tblNon_working_days 
    Dim db As DAO.Database 
    Dim rst As DAO.Recordset 
    Dim i As Long 


    Set rst = DBEngine(0)(0).OpenRecordset("tblNon_working_days", dbOpenSnapshot) 
    With rst 
     If .RecordCount > 0 Then 
      i = 1 
      .MoveFirst 
      Do Until .EOF 
       ReDim Preserve adtmDates(i) 
       adtmDates(i) = !Date 
       .MoveNext 
       i = i + 1 
      Loop 
     End If 
    End With 

    rst.Close 
    db.Close 
    Set rst = Nothing 
    Set db = Nothing 

    If dtmDate = 0 Then 
     dtmDate = Date 
    End If 

    dtmTemp = dtmDate 
    For lngCount = 1 To lngDays 
     dtmTemp = dhNextWorkdayA(dtmTemp, adtmDates) 
    Next lngCount 
    dhAddWorkDaysA = dtmTemp 
End Function 
Public Function dhNextWorkdayA(_ 
Optional dtmDate As Date = 0, _ 
Optional adtmDates As Variant = Empty) As Date 

    ' Return the next working day after the specified date. 

    ' Modified from code in 
    ' "Visual Basic Language Developer's Handbook" 
    ' by Ken Getz and Mike Gilbert 
    ' Copyright 2000; Sybex, Inc. All rights reserved. 

    ' Requires: 
    ' SkipHolidays 
    ' IsWeekend 

    ' In: 
    ' dtmDate: 
    '  date on which to start looking. 
    '  Use the current date, if none was specified. 
    ' adtmDates (Optional): 
    '  Array containing holiday dates. Can also be a single 
    '  date value. 
    ' Out: 
    ' Return Value: 
    '  The date of the next working day, taking 
    '  into account weekends and holidays. 
    ' Example: 
    ' ' Find the next working date after 5/30/97 
    ' dtmDate = dhNextWorkdayA(#5/23/1997#, #5/26/97#) 
    ' ' dtmDate should be 5/27/97, because 5/26/97 is Memorial day. 

    ' Did the caller pass in a date? If not, use 
    ' the current date. 
    If dtmDate = 0 Then 
     dtmDate = Date 
    End If 

    dhNextWorkdayA = SkipHolidaysA(adtmDates, dtmDate + 1, 1) 
End Function 
Private Function SkipHolidaysA(_ 
adtmDates As Variant, _ 
dtmTemp As Date, intIncrement As Integer) As Date 
    ' Skip weekend days, and holidays in the array referred to by adtmDates. 
    ' Return dtmTemp + as many days as it takes to get to a day that's not 
    ' a holiday or weekend. 

    ' Modified from code in 
    ' "Visual Basic Language Developer's Handbook" 
    ' by Ken Getz and Mike Gilbert 
    ' Copyright 2000; Sybex, Inc. All rights reserved. 

    ' Required by: 
    ' dhFirstWorkdayInMonthA 
    ' dbLastWorkdayInMonthA 
    ' dhNextWorkdayA 
    ' dhPreviousWorkdayA 
    ' dhCountWorkdaysA 

    ' Requires: 
    ' IsWeekend 

    Dim strCriteria As String 
    Dim strFieldName As String 
    Dim lngItem As Long 
    Dim blnFound As Boolean 

    On Error GoTo HandleErrors 

    ' Move up to the first Monday/last Friday, if the first/last 
    ' of the month was a weekend date. Then skip holidays. 
    ' Repeat this entire process until you get to a weekday. 
    ' Unless adtmDates an item for every day in the year (!) 
    ' this should finally converge on a weekday. 

    Do 
     Do While IsWeekend(dtmTemp) 
      dtmTemp = dtmTemp + intIncrement 
     Loop 
     Select Case VarType(adtmDates) 
      Case vbArray + vbDate, vbArray + vbVariant 
       Do 
        blnFound = FindItemInArray(dtmTemp, adtmDates) 
        If blnFound Then 
         dtmTemp = dtmTemp + intIncrement 
        End If 
       Loop Until Not blnFound 
      Case vbDate 
       If dtmTemp = adtmDates Then 
        dtmTemp = dtmTemp + intIncrement 
       End If 
     End Select 
    Loop Until Not IsWeekend(dtmTemp) 

ExitHere: 
    SkipHolidaysA = dtmTemp 
    Exit Function 

HandleErrors: 
    ' No matter what the error, just 
    ' return without complaining. 
    ' The worst that could happen is that we 
    ' include a holiday as a real day, even if 
    ' it's in the array. 
    Resume ExitHere 

End Function 
Private Function IsWeekend(dtmTemp As Variant) As Boolean 
    ' If your weekends aren't Saturday (day 7) and Sunday (day 1), 
    ' change this routine to return True for whatever days 
    ' you DO treat as weekend days. 

    ' Modified from code in "Visual Basic Language Developer's Handbook" 
    ' by Ken Getz and Mike Gilbert 
    ' Copyright 2000; Sybex, Inc. All rights reserved. 

    ' Required by: 
    ' SkipHolidays 
    ' dhFirstWorkdayInMonth 
    ' dbLastWorkdayInMonth 
    ' dhNextWorkday 
    ' dhPreviousWorkday 
    ' dhCountWorkdays 

    If VarType(dtmTemp) = vbDate Then 
     Select Case WeekDay(dtmTemp) 
      Case vbSaturday, vbSunday 
       IsWeekend = True 
      Case Else 
       IsWeekend = False 
     End Select 
    End If 
End Function 

Private Function FindItemInArray(varItemToFind As Variant, _ 
avarItemsToSearch As Variant) As Boolean 
    Dim lngItem As Long 

    On Error GoTo HandleErrors 

    For lngItem = LBound(avarItemsToSearch) To UBound(avarItemsToSearch) 
     If avarItemsToSearch(lngItem) = varItemToFind Then 
      FindItemInArray = True 
      GoTo ExitHere 
     End If 
    Next lngItem 

ExitHere: 
    Exit Function 

HandleErrors: 
    ' Do nothing at all. 
    ' Return False. 
    Resume ExitHere 
End Function