De: "Frédéric Sigonneau" Objet: Re: calcul d'heures "ouvrables" entre deux dates Date : samedi 23 décembre 2000 01:15 Bonsoir Pascal, Avec tes précisions, je tente une solution qui mélange formule de feuille de calcul et fonctions VBA. Ce qui suit suppose que les entrés soient au format date+heure dans les cellules des colonnes à traiter (ce que laisse supposer ton message). Dans ce cas : En A1 : 30/6/00 15:15 En B1 : 4/7/00 11:00 En C1 : =SI((B1-ENT(B1))<(A1-ENT(A1));MOD((B1-ENT(B1))-(A1-ENT(A1));10/24);B1-A1)+(delai(A1;B1)*(8/24)) La première partie de la formule (fonction si) calcule la différence entre les *heures* en B1 et A1. La fonction DELAI calcule la différence entre les *jours* en B1 et A1, en déduisant 1 jour "normal" de délai d'intervention (pris en compte par la fonction si), les dimanches et fériés, et la moitié des samedis. Cette différence, multiplié par 8h "utiles" par jour est ajouté à la différence des heures. La fonction DELAI utilise la fonction TYPEJOUR de Laurent Longre, légèrement modifié pour renvoyer un résultat différent pour les samedis et les dimanches. Elle a donc la même limite de validité (2099) pour le calcul des jours fériés mobiles. Ci-dessous le code, à recopier dans un module standard de ton classeur. FS '========================================= Function DELAI(D1 As Double, D2 As Double) Dim DateDep, DateFin DateDep = Int(D1) DateFin = Int(D2) DELAI = DateFin - DateDep - 1 If DELAI > 1 Then For i = DateDep To DateFin If TYPEJOUR(i) = 2 Or TYPEJOUR(i) = 3 Then DELAI = DELAI - 1 If TYPEJOUR(i) = 1 Then DELAI = DELAI - 0.5 Next i End If If DELAI = 1 Then DELAI = 0 End Function Function TYPEJOUR(ByVal D As Date) 'L. Longre 'modifié pour renvoyer 1 pour les samedis et 3 pour les dimanches '0 -> jour de semaine ouvrable, 2-> jour férié 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 If Weekday(D, vbMonday) = 6 Then TYPEJOUR = 1 'Dimanche If Weekday(D, vbMonday) = 7 Then TYPEJOUR = 3 End Select End Function '======================================= Pascal Couteliez a écrit : > > boujour à tous > > merci a Michel et Frédéric pour leur réponse mais le problème est toujours > le même. > > J'explique un peu plus! > Le fichier en question à pour but de suivre l'activité d'un Helpdesk > > le problème: > 1 appel est ouvert le 30/06/00 15:15:00 avec un délai ouvrable de 5 h pour > résoudre le problème s'en suit un délai d'intervention 01/07/00 09:30:00 > (arrivé du Technicien) puis un délai de réparation 00:45:00. > Le cumul des deux fournit un délai de remise en état (qui ne doit pas exéder > 5 h) et une date et heure de cloture 01/07/00 10:15:00 > Le temps écoulé entre le top départ et le top arrivé est de 19:00:00 donc > surpérieur à 5 h mais le temps à prendre en compte est de 02:45:00 le > 30/06/00 temps restant jusqu'à 18 h + 02:15:00 le 01/07/00 soit un total de > 05:00:00 donc dans les temps. > > à savoir que les heure d'ouvertures de l'agence sont de 8h à 12h et de 14h à > 18h les heures de pause étant également à décompter de plus le client est > ouvert le samedi matin de 8h à 12h ce qui n'arrange pas le problème car la > fonction NB.JOURS.OUVRES ne tient pas compte des samedis & dimanches (même > si je les intègre dans la liste des jours fériers) pour finir j'ai des > clients avec des horaires d'ouvertures différents et je ne connait pas le > VBA ! > > Voilà toutes les donnés du problème > le but étant de repérer les interventions hors délai dans un fichier de > 45000 lignes pour pour gérer les litiges client. > > Si qq à une idé ça me ferais un chouette cadeau de Noël et j'ai une > bouteille de vendanges tardives (Blanc d'Alsace) à titre de remerciements > > Bonne fêtes à tous > > Pascal Couteliez > Support Bureautique Niveau 1 > EBC-INFORMATIQUE > pcouteliez@ebc-informatique.com -- Frédéric Sigonneau [né un Sans-culottide !] Gestions de temps : http://perso.wanadoo.fr/frederic.sigonneau