problème sur des heures

goldfinger13

XLDnaute Occasionnel
bonsoir à toutes et à tous,
je rencontre une difficulté en travaillant sur des heures et très franchement je ne suis pas du tout sur de la formule ce qui est sûr c'est qu'elle buggue et je ne m'en sors pas
en fait j'ai 4 conditions
le résultat étant attendu en cellule Q2

si la valeur de la cellule J2 est = 0 sanction "pas flashé"
si valeur J2 est supérieur ou égal à N2 et inférieur ou égal à P2 sanction "RAS"
si J2 est inférieur à N2 sanction "trop tôt"
si J2 est supérieur à P2 sanction "trop tard"

j'ai bien traduit cela par une "simple formule" qui fonctionne:

Code:
=SI(J2=0;"PAS FLASHE";SI(ET(HEURE(J2)*60+MINUTE(J2)>=HEURE(N2)*60+MINUTE(N2);HEURE(J2)*60+MINUTE(J2)<=HEURE(P2)*60+MINUTE(P2));"RAS";SI(HEURE(J2)*60+MINUTE(J2)<HEURE(N2)*60+MINUTE(N2);"TROP TOT";SI(HEURE(J2)*60+MINUTE(J2)>HEURE(P2)*60+MINUTE(P2);"TROP TARD"))))

Mais compte tenu que j'ai plus de 10000 lignes a traiter et très régulièrement je souhaitais automatiser la tache en VBA

l'enregistreur de macro ne veut pas m'aider il refuse carrément d'enregistrer la chose
j'ai tenté de traduire de cette manière mais ;(

Code:
Sub sanction_bis()

Dim derLig As Long
derLig = [A65000].End(xlUp).Row
With Range("Q2:Q" & derLig)
    .FormulaR1C1 = _
        "=IF(RC[-5]=0,""Pas flashé"",IF(AND(HOUR(RC[-5])*60+MINUTE(RC[-5])>=(HOUR(RC[-3])*60+MINUTE(RC[-3]),(HOUR(RC[-5])*60+MINUTE(RC[-5])<=(HOUR(RC[-1])*60+MINUTE(RC[-1],""RAS"",(HOUR(RC[-7])*60+MINUTE(RC[-7])<(HOUR(RC[-7])*60+MINUTE(RC[-7]),""TROP TOT"",SI(HOUR(RC[-7])*60+MINUTE(RC[-7])>(HOUR(RC[-1])*60+MINUTE(RC[-1],""TROP TARD"")))"
End With
End Sub

si vous pouviez m'aider j'en serais ravi
 

Chris401

XLDnaute Accro
Re : problème sur des heures

Bonsoir

Essaye :
Code:
Sub sanction_bis()

Dim derLig As Long
derLig = [A65000].End(xlUp).Row
    With Range("Q2")
    .FormulaR1C1 = _
        "=IF(RC[-5]=0,""Pas flashé"",IF(AND(HOUR(RC[-5])*60+MINUTE(RC[-5])>=(HOUR(RC[-3])*60+MINUTE(RC[-3]),(HOUR(RC[-5])*60+MINUTE(RC[-5])<=(HOUR(RC[-1])*60+MINUTE(RC[-1],""RAS"",(HOUR(RC[-7])*60+MINUTE(RC[-7])<(HOUR(RC[-7])*60+MINUTE(RC[-7]),""TROP TOT"",SI(HOUR(RC[-7])*60+MINUTE(RC[-7])>(HOUR(RC[-1])*60+MINUTE(RC[-1],""TROP TARD"")))"
     .AutoFill Destination:=Range("Q2:Q" & derLig), Type:=xlFillDefault
End With
End Sub
Cordialement
Chris
 

goldfinger13

XLDnaute Occasionnel
Re : problème sur des heures

voilà la pièce jointe mon probleme se pose pour la colonne Q ou je n'arrive pas a trouver le code VBA

@ chris: le probleme sur la partie avec les SI la formule elle meme
 

Pièces jointes

  • formule.xls
    20 KB · Affichages: 48
  • formule.xls
    20 KB · Affichages: 40
  • formule.xls
    20 KB · Affichages: 47

Hippolite

XLDnaute Accro
Re : problème sur des heures

Bonsoir à tous,
Pourquoi pas un bon petit Select Case
VB:
Sub sanction_bis()
	Dim derLig As Long
	derLig = [A65000].End(xlUp).Row
	For i = 2 to derlig
		Select Case Range("J" & i)
			Case Is = 0
				Range("Q" & i) = "pas flashé"
			Case Is > 0 And Is < Range("N" & i)
				Range("Q" & i) = "trop tôt"
			Case Is  >= Range("N" & i) And Is <= Range("P" & i)
				Range("Q" & i) = "RAS"
			Case Is > Range("P" & i)
				Range("Q" & i) = "trop tard"
		End Select
	Next i
End Sub
Non testé, je n'ai pas Excel sous la main.
A+
 
Dernière édition:

goldfinger13

XLDnaute Occasionnel
Re : problème sur des heures

Bonsoir à tous,
Pourquoi pas un bon petit Select Case
VB:
Sub sanction_bis()
	Dim derLig As Long
	derLig = [A65000].End(xlUp).Row
	For i = 2 to derlig
    Select Case Range("J" & i)
        Case Is = 0
			Range("Q" & i) = "pas flashé"
        Case Is > 0 And Is < Range("N" & i)
            Range("Q" & i) = "trop tôt"
        Case Is  >= Range("N" & i) And Is <= Range("P" & i)
            Range("Q" & i) = "RAS"
		Case Is > Range("P" & i)
			Range("Q" & i) = "trop tard"
    End Select
End Sub
Non testé, je n'ai pas Excel sous la main.
A+

bonsoir Hippolite
erreur de syntaxe sur les lignes avec AND elles sont en rouge
merci pour ton aide
 

klin89

XLDnaute Accro
Re : problème sur des heures

Bonsoir Hippolite
Bonsoir à tous,

Sans vouloir m'immiscer, peut-être comme ceci :

VB:
Sub sanction_bis()
    Dim derLig As Long
    derLig = [A65000].End(xlUp).Row
    For i = 2 To derLig
        Select Case Range("J" & i)
            Case Is = 0
                Range("Q" & i) = "pas flashé"
            Case Is > 0, Is < Range("N" & i)
                Range("Q" & i) = "trop tôt"
            Case Is >= Range("N" & i), Is <= Range("P" & i)
                Range("Q" & i) = "RAS"
            Case Is > Range("P" & i)
                Range("Q" & i) = "trop tard"
        End Select
    Next i
End Sub

Klin89
 

Hippolite

XLDnaute Accro
Re : problème sur des heures

Re,
Après réflexion :
VB:
Sub sanction_bis()
	Dim derLig As Long
	derLig = [A65000].End(xlUp).Row
	For i = 2 to derlig
		Select Case Range("J" & i)
			Case Is = 0
				Range("Q" & i) = "pas flashé"
			Case  Is < Range("N" & i)
				Range("Q" & i) = "trop tôt"
			Case Is <= Range("P" & i)
				Range("Q" & i) = "RAS"
			Case Is > Range("P" & i)
				Range("Q" & i) = "trop tard"
		End Select
	Next i
End Sub
A+

Edit : En effet, si les conditions sont réalisées dans plusieurs Case, seules les instructions qui suivent la première correspondance s'exécutent. Il suffit donc de les laisser dans l'ordre croissant et de tester chaque seuil l'un après l'autre.
 
Dernière édition:

Hippolite

XLDnaute Accro
Re : problème sur des heures

Re,
La touche finale :
comme tu as beaucoup de lignes à traiter, j'ai ajouté le gel de l'affichage et des recalculs afin de réduire le temps d'exécution de la macro.
VB:
Sub sanction_bis()
	Dim derLig As Long
	'Désactive la mise à jour de l'affichage
	Application.ScreenUpdating = False
	'Désactive la mise à jour des recalculs
	Application.Calculation = xlCalculationManual
	derLig = [A65000].End(xlUp).Row
	For i = 2 to derlig
		Select Case Range("J" & i)
			Case Is = 0
				Range("Q" & i) = "pas flashé"
			Case  Is < Range("N" & i)
				Range("Q" & i) = "trop tôt"
			Case Is <= Range("P" & i)
				Range("Q" & i) = "RAS"
			Case Is > Range("P" & i)
				Range("Q" & i) = "trop tard"
		End Select
	Next i
	'Ré-activations
	Application.Calculation = xlCalculationAutomatic
	Application.ScreenUpdating = True
End Sub
A+