Bonsoir,
je cherche à obtenir le nb de jours entre de dates en tenant compte de l'heure.
avez vous des infos sur le sujet
merci d'avance
AT41 = 02/04/2009 14:16
AV41 = 03/04/2009 14:00
=NB.JOURS.OUVRES(AT41;AV41;Teams!$D$8:$D$19)) = 1
AT1 = 06/04/2009 10:08
AV1 = 06/04/2009 12:05
la formule me donne 1 alors que c'est 2 heures
en utilisant une macro idem :
Function NbOuvres(D1, D2)
Dim Prem As Date, Der As Date, i As Date
If D1 = D2 Then
Prem = D1
If TYPEJOUR(Prem) = 0 Then NbOuvres = 1
Exit Function
End If
Select Case D1 < D2
Case True: Prem = D1: Der = D2
Case False: Prem = D2: Der = D1
End Select
For i = Prem To Der
NbOuvres = NbOuvres + (TYPEJOUR(i) = 0) * -1
Next i
End Function
Function TYPEJOUR(D As Date)
Dim A As Integer, T As Integer
Dim LP As Date, LD As Long
Dim Toto As Long
A = Year(D)
If A > 2099 Then
TYPEJOUR = CVErr(xlErrValue)
Exit Function
End If
LD = Int(D)
If LD <= 2 Then
If LD = 1 Then TYPEJOUR = 2
Exit Function
End If
T = (((255 - 11 * (A Mod 19)) - 21) Mod 30) + 21
LP = DateSerial(A, 3, 2) + T + (T > 48) _
+ 6 - ((A + A \ 4 + T + (T > 48) + 1) Mod 7)
Select Case D
' Jours fériés mobiles
Case Is = LP, Is = LP + 38, Is = LP + 49
TYPEJOUR = 2
' Jours fériés fixes
Case Is = DateSerial(A, 1, 1), Is = DateSerial(A, 5, 1), _
Is = DateSerial(A, 5, 8), Is = DateSerial(A, 7, 14), _
Is = DateSerial(A, 8, 15), Is = DateSerial(A, 11, 1), _
Is = DateSerial(A, 11, 11), Is = DateSerial(A, 12, 25)
TYPEJOUR = 2
Case Else
' Samedi ou dimanche
If Weekday(D, vbMonday) >= 6 Then TYPEJOUR = 1
End Select
End Function
je cherche à obtenir le nb de jours entre de dates en tenant compte de l'heure.
avez vous des infos sur le sujet
merci d'avance
AT41 = 02/04/2009 14:16
AV41 = 03/04/2009 14:00
=NB.JOURS.OUVRES(AT41;AV41;Teams!$D$8:$D$19)) = 1
AT1 = 06/04/2009 10:08
AV1 = 06/04/2009 12:05
la formule me donne 1 alors que c'est 2 heures
en utilisant une macro idem :
Function NbOuvres(D1, D2)
Dim Prem As Date, Der As Date, i As Date
If D1 = D2 Then
Prem = D1
If TYPEJOUR(Prem) = 0 Then NbOuvres = 1
Exit Function
End If
Select Case D1 < D2
Case True: Prem = D1: Der = D2
Case False: Prem = D2: Der = D1
End Select
For i = Prem To Der
NbOuvres = NbOuvres + (TYPEJOUR(i) = 0) * -1
Next i
End Function
Function TYPEJOUR(D As Date)
Dim A As Integer, T As Integer
Dim LP As Date, LD As Long
Dim Toto As Long
A = Year(D)
If A > 2099 Then
TYPEJOUR = CVErr(xlErrValue)
Exit Function
End If
LD = Int(D)
If LD <= 2 Then
If LD = 1 Then TYPEJOUR = 2
Exit Function
End If
T = (((255 - 11 * (A Mod 19)) - 21) Mod 30) + 21
LP = DateSerial(A, 3, 2) + T + (T > 48) _
+ 6 - ((A + A \ 4 + T + (T > 48) + 1) Mod 7)
Select Case D
' Jours fériés mobiles
Case Is = LP, Is = LP + 38, Is = LP + 49
TYPEJOUR = 2
' Jours fériés fixes
Case Is = DateSerial(A, 1, 1), Is = DateSerial(A, 5, 1), _
Is = DateSerial(A, 5, 8), Is = DateSerial(A, 7, 14), _
Is = DateSerial(A, 8, 15), Is = DateSerial(A, 11, 1), _
Is = DateSerial(A, 11, 11), Is = DateSerial(A, 12, 25)
TYPEJOUR = 2
Case Else
' Samedi ou dimanche
If Weekday(D, vbMonday) >= 6 Then TYPEJOUR = 1
End Select
End Function