nbjours ouvrés ente 2 dates avec pris en compte heure

[jot]

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

 

[PMO2]

Re : nbjours ouvrés ente 2 dates avec pris en compte heure

Bonjour,

Une piste, au moyen d'une fonction personnalisée, pour afficher la différence entre 2 dates exprimée en nombre de jours, heures, minutes.
Cette fonction renvoie une chaîne sous, par exemple, cette forme 6 jour(s) 23 h 44 m.

Copiez le code suivant dans un module Standard

Function Diff_Date_jhm(Date1 As Date, Date2 As Date) As String
Dim Ancienne As Date
Dim Recente As Date
Dim var
Dim jour&
Dim A$
If Date1 < Date2 Then
  Ancienne = Date1
  Recente = Date2
Else
  Ancienne = Date2
  Recente = Date1
End If
var = Recente - Ancienne
If InStr(1, CStr(var), ".") = 0 Then
  jour& = CLng(var)
Else
  jour& = CLng(Mid(CStr(var), 1, InStr(1, CStr(var), ".") - 1))
End If
var = var - jour&
If jour& > 1 Then
  A$ = jour& & " jour(s) " & Hour(var) & " h " & Minute(var) & " m"
Else
  A$ = jour& & " jour " & Hour(var) & " h " & Minute(var) & " m"
End If
Diff_Date_jhm = A$
End Function

Tapez 02/04/2009 14:16 en A1
Tapez 03/04/2009 14:00 en A2
Tapez la formule =Diff_Date_jhm(A1;A2) en B1

Cordialement.

PMO
Patrick Morange

 

[jot]

Re : nbjours ouvrés ente 2 dates avec pris en compte heure

Bonsoir

merci pour la réponse

est ce que le code prend en charge le calculs en jours ouvres ?

lorsque j'applique la fonction j'ai ===> #VALEUR!
cordialement

 

[PMO2]

Re : nbjours ouvrés ente 2 dates avec pris en compte heure

Bonsoir,

Effectivement, il y avait un bug lorsque les dates sont des jours pleins (sans heure et sans minute). J'ai fait la correction dans mon précédent message et la pièce jointe qui s'y trouve est mise à jour. Veuillez, par conséquent, reconsidérer mon 1er message.

Pour les jours ouvrés, je n'ai pas fait de distinction et la fonction traite TOUS les jours en général.

Qu'entendez-vous par jours ouvrés ?
Je suppose qu'il s'agit de l'exclusion des samedis et des dimanches mais y excluez-vous aussi les jours fériés (Noël, 8 mai, 11 novembre, et les fériés mobiles) ?
Si c'est le cas, on peut utiliser l'algorithme de Thomas O’Beirne pour déterminer la date de Pâques puis en déduire les jours fériés mobiles.

Cordialement.

PMO
Patrick Morange

 

[jot]

Re : nbjours ouvrés ente 2 dates avec pris en compte heure

merci pour les infos et le code

oui en fait quand je parle de jours ouvres il s'agit bien d'exclure les samedis, dimanches et jours fériés

cordialment