120 | 200 |
450 | 240 |
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
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
Bonjour.
Pourquoi trouvez vous 2 heures normales de 04:00:00 à 07:00:00 ?
Moi je ne trouve que 1 heure avec ce code :
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
Fichier (3) et la macro affectée au bouton :Je ne souhaite pas de formule dans le classeur
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
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