XL 2013 calcul d'heure tranche horaires

[kjin]

salut
J'espère que vous avez tous pris la mesure du pb qui nous arrive et adopté les mesures nécessaires, sans morale aucune
Ca fait bien longtemps que ne suis plus sur XLD, mais cette fois c'est moi qui pose la question
Une pensée pour toutes celles et ceux remarquables que j'ai pu croiser ici, et qui qqfois sont allés vers d'autres cieux
En vba s'il vous plait, je mettrai dans un onglet la plage heures de nuit - 22h-06h00 qui peut évoluer
2 cellules horaires - début - fin
Monique et Céléda avait travaillé remarquablement sur le sujet...par formules
A partir de ces 2 uniques cellules !
merci beaucoup pour votre aide
Et le fichier en Pj

 

[Christian0258]

Bonjour à tout le forum,

Ci-joint un planning colonne avec des fonctions...
C'est un travail de Job75 suite à une des mes demandes à l'époque.

Bien à vous

 

[jmfmarques]

Bonjour Staple
Hé hé ! En plein ce que j'imaginais (des heures seules au lieu de dates/heures) ! Je vais laisser kjin mettre en oeuvre la prémière partie (transformer tout cela en écart minutes par rapport à une date/heure d'origine).
Le reste (ce qu'il y a ensuite à faire sur la base de ces données) est tout simplement mon code .
exemple de résultat avec travail en colonne A et définition nuit en colonne B :

120​	200​
450​	240​

affichera : "41 minutes de nuit"
Oilà oilà ...

 

[Dranreb]

Bonjour.
Pourquoi trouvez vous 2 heures normales de 04:00:00 à 07:00:00 ?
Moi je ne trouve que 1 heure avec ce code :

Sub Test()
   Dim T(), L As Long, HNorm As Double, HNuit As Double
   T = ActiveSheet.[A2:B2].Resize(ActiveSheet.[A65000].End(xlUp).Row - 1).Value
   For L = 1 To UBound(T, 1)
      CalcHNormHNuit HNorm, HNuit, T(L, 1), T(L, 2)
      T(L, 1) = HNorm: T(L, 2) = HNuit: Next L
   ActiveSheet.[C2:D2].Resize(UBound(T, 1)).Value = T
   End Sub
Sub CalcHNormHNuit(ByRef HNorm As Double, ByRef HNuit As Double, ByVal HDéb As Double, ByVal HFin As Double)
   Dim Sec As Long
   HDéb = Int(HDéb * 86400# + 0.5): HFin = Int(HFin * 86400# + 0.5)
   Sec = Borné(HDéb, 79200#, HFin) - Borné(HDéb, 21600#, HFin): If Sec < 0 Then Sec = Sec + 57600
   HNorm = Sec / 3600
   Sec = HFin - HDéb - Sec: If Sec < 0 Then Sec = Sec + 86400
   HNuit = Sec / 3600
   End Sub
Private Function Borné(ByVal LimInf As Double, ByVal V As Double, ByVal LimSup As Double) As Double
   Borné = (LimInf + Abs(V - LimInf) - Abs(LimSup - V) + LimSup) / 2
   End Function

 

[jmfmarques]

Bonjour Dranreb
Je me suis fait la même remarque, au vu de l'image qu'a bien voulu communiquer Staple.
Je suppose qu'il ne s'agit pas là d'un résultat de formule, mais d'une saisie manuelle erronée d'un résultat attendu (interversion de deux données).

 

[Staple1600]

Re, Bonjour Dranreb

•>jmfmarques
Non pas de saisie manuelle (enfin je crois, non pardon je suppute)
Car il y aussi ceci dans le classeur de kjin.

Sub zz()
ActiveCell = ((Range("B1").Value - Range("a1").Value) Mod 1) / 24
End Sub
Sub Macro1()
' ActiveCell.Formula(a = "=MOD([b1]-[a1],1)"
Range("D3").Select
End Sub

 

[CISCO]

Bonjour

Bonjour.
Pourquoi trouvez vous 2 heures normales de 04:00:00 à 07:00:00 ?
Moi je ne trouve que 1 heure avec ce code :

Effectivement, ligne 7, c'est, 1 h de jour et 2 h de nuit, et pas le contraire, comme c'est écrit.

@ plus

 

[job75]

Bonjour kjin, heureux de te revoir, bonjour les autres,

J'ai supprimé mon message précédent.

Voyez le fichier joint et cette fonction VBA relativement simple :

Function HNormales(deb, fin, t1, t2)
Dim t3%, h%
If fin < deb Then fin = fin + 1
deb = CInt(1440 * deb): fin = CInt(1440 * fin)
t1 = CInt(1440 * t1): t2 = CInt(1440 * t2)
t3 = t2 + 1440 'le lendemain
For h = deb To fin
    If h < t1 And h > t2 Or h > t3 Then HNormales = HNormales + 1 'minutes
Next
HNormales = HNormales / 60 'heures
End Function

Pas certain que tous les cas de figure seront pris en compte...

A+

 

[kjin]

Bonsoir à tous et merci pour vos réponses
En effet il y a une erreur entre 4h et 7h, h normales et h nuit sont inversées, toutes mes excuses
En fait, il s'agit d'un planning que j'ai élaboré en 2014, que j'ai du ressortir, mais avec cette contrainte des h de nuit que je n'avais pas alors, et pour éviter d'alourdir le classeur qui contient déjà beaucoup de formules, je souhaite faire les calcul en VBA
Les cellules en colonne A et B sont associées à une macro événementielle qui ouvre un formulaire pour saisir les horaires afin d'éviter les erreurs; jusqu'alors, le total était ventilé en colonne C dès lors que les cellules en A et B adjacentes étaient renseignées
Je n'ai pas encore testé vos solutions car je n'avais pas eu de notification
Encore merci à vous en espérant avoir été plus clair

 

[job75]

Petite amélioration dans ce fichier (2) :

If fin > t1 And deb > fin Then HNormales = "Exagéré !": Exit Function

Avec ça tous les cas de figure sont traités non ?

 

[kjin]

Bonsoir Job,
Nos messages se sont croisés
Merci pour la réponse
Je teste vos solutions et reviens vers vous
A bientôt

 

[kjin]

Bonsoir Job,
Toujours aussi alerte et brillant !
Je ne souhaite pas de formule dans le classeur, je vais donc adapter...et ce n'est pas gagné je n'ai pas écris une ligne de code depuis fort longtemps
Encore merci et bonne soirée

 

[job75]

Je ne souhaite pas de formule dans le classeur

Fichier (3) et la macro affectée au bouton :

Sub Calcul()
With ActiveSheet.UsedRange
    If .Rows.Count = 1 Then Exit Sub
    With .Cells(2, 3).Resize(.Rows.Count - 1, 2)
        .Columns(1) = "=HNormales(A2,B2,G$7,H$7)"
        .Columns(2) = "=IF(ISTEXT(C2),C2,24*(B2-A2+(A2>B2))-C2)"
        .Value = .Value 'supprime les formules
    End With
End With
End Sub

Bien sûr le tableau doit toujours commencer en A1.

Edit : notez en D2 et D4 les valeurs négatives très petites qui sont aussi masquées par le format.

Bonne nuit.

 

[job75]

Bonjour kjin, le forum,

Voyez ce fichier (3 bis) avec un ROUND (ARRONDI) dans la formule de la colonne D.

De cette manière on peut faire supprimer les valeurs zéro par la macro :

Sub Calcul()
With ActiveSheet.UsedRange
    If .Rows.Count = 1 Then Exit Sub
    With .Cells(2, 3).Resize(.Rows.Count - 1, 2)
        .Columns(1) = "=HNormales(A2,B2,G$7,H$7)"
        .Columns(2) = "=IF(ISTEXT(C2),C2,ROUND(24*(B2-A2+(A2>B2))-C2,1))"
        .Value = .Value 'supprime les formules
        .Replace 0, "", xlWhole 'supprime les valeurs zéro
    End With
End With
End Sub

Bonne journée.

 

[Dranreb]

@kjin, bonjour.
Avez vous aussi testé ma solution du poste #18 ?

 

[xenondeele]

sans vba; sans calcul matriciel