Soustraction en loupe vba
Résolu
lanetmel
Messages postés
200
Date d'inscription
Statut
Membre
Dernière intervention
-
lanetmel Messages postés 200 Date d'inscription Statut Membre Dernière intervention -
lanetmel Messages postés 200 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
J'aimerais faire plusieurs soustractions en loupe. J'ai mon code pour les faire un à la suite de l'autre mais ça n'a pas de sens de tous les écrire...
Voici le code que j'ai présentement :
Private Sub worksheet_Change(ByVal Target As Range)
Dim resultat
If (Not Intersect(Target, Range("K6:K7")) Is Nothing) Then
If Range("K6").Value - Range("K7").Value > 2 Then
MsgBox "POINT DE CONSIGNE TEMP SÈCHE NON RESPECTÉ"
End If
End If
If (Not Intersect(Target, Range("K8:K9")) Is Nothing) Then
If Range("K8").Value - Range("K9").Value > 2 Then
MsgBox "POINT DE CONSIGNE TEMP SÈCHE NON RESPECTÉ"
End If
End If
J'aimerais faire un code afin que le code se répète jusqu'à K90etK91...
pouvez-vous m'aider svp?
J'aimerais faire plusieurs soustractions en loupe. J'ai mon code pour les faire un à la suite de l'autre mais ça n'a pas de sens de tous les écrire...
Voici le code que j'ai présentement :
Private Sub worksheet_Change(ByVal Target As Range)
Dim resultat
If (Not Intersect(Target, Range("K6:K7")) Is Nothing) Then
If Range("K6").Value - Range("K7").Value > 2 Then
MsgBox "POINT DE CONSIGNE TEMP SÈCHE NON RESPECTÉ"
End If
End If
If (Not Intersect(Target, Range("K8:K9")) Is Nothing) Then
If Range("K8").Value - Range("K9").Value > 2 Then
MsgBox "POINT DE CONSIGNE TEMP SÈCHE NON RESPECTÉ"
End If
End If
J'aimerais faire un code afin que le code se répète jusqu'à K90etK91...
pouvez-vous m'aider svp?
2 réponses
-
Bonjour,
Dans ton "truc", je pense déjà qu'il te faut faire deux actions différentes :
Soit la ligne ou tu changes la valeur en K est une ligne paire (K6, K8 etc...), soit elle est impaire. Si elle est paire, on teste avec la ligne du dessous, si impaire, alors on teste avec la ligne du dessus. Non?
Si oui essaye :Private Sub worksheet_Change(ByVal Target As Range) 'teste qu'une seule cellule soit sélectionnée et que la ligne soit au moins la ligne 6 If Target.Count > 1 Or Target.Row < 6 Then Exit Sub If (Not Intersect(Target, Columns("K:K")) Is Nothing) Then 'si impaire If Target.Row And 1 Then If Cells(Target.Row - 1, "K").Value - Cells(Target.Row, "K").Value > 2 Then MsgBox "POINT DE CONSIGNE TEMP SÈCHE NON RESPECTÉ" End If Else 'si paire If Cells(Target.Row, "K").Value - Cells(Target.Row + 1, "K").Value > 2 Then MsgBox "POINT DE CONSIGNE TEMP SÈCHE NON RESPECTÉ" End If End If End If End Sub
ps : je n'ai pas testé ce code...
Cordialement,
Franck P -
Bonjour Franck,
merci encore pour ton aide! ça fonctionne très bien seulement, il n'est pas nécessaire de dire si c'est pair ou impair car les deux cases doivent être remplies en même temps... Seulement j'ai deux colonnes comme ça alors j'ai mis le code comme suit :
'teste qu'une seule cellule soit sélectionnée et que la ligne soit au moins la ligne 6
If Target.Count > 1 Or Target.Row < 6 Then Exit Sub
If (Not Intersect(Target, Columns("K:K")) Is Nothing) Then
'si impaire
If Target.Row And 1 Then
If Cells(Target.Row - 1, "K").Value - Cells(Target.Row, "K").Value > 2 Then
MsgBox "POINT DE CONSIGNE TEMP SÈCHE NON RESPECTÉ"
End If
End If
'teste qu'une seule cellule soit sélectionnée et que la ligne soit au moins la ligne 6
If Target.Count > 1 Or Target.Row < 6 Then Exit Sub
If (Not Intersect(Target, Columns("M:M")) Is Nothing) Then
'si impaire
If Target.Row And 1 Then
If Cells(Target.Row - 1, "M").Value - Cells(Target.Row, "M").Value > 2 Then
MsgBox "POINT DE CONSIGNE TEMP HUMIDE NON RESPECTÉ"
End If
End If
ça fonctionne très bien pour la colonne K mais il ne se passse rien dans la colonne M. Sais-tu pourquoi?
merci
Mélanie-
Mélanie,
1- Tu as oublié 2 End If...
2- ce code, avec des end if en + fonctionne bien.
3- remarque : ne pas mettre deux fois cette même ligne : If Target.Count > 1 Or Target.Row < 6 Then Exit Sub
4- puisque tu veux rigoureusement le même test sur deux colonnes, il convient de sortir de la procédure si les conditions suivantes ne sont pas remplies :
- colonne différente de 11 (col K)
- colonne différente de 13 (col M)
- ligne inférieure à 6
- sélection de + d'1 cellule.
Ces conditions se traduisent en VBA par :If Target.Count > 1 Or Target.Row < 6 Or Target.Column <> 11 And Target.Column <> 13
Si une seule est vraie alors on ne fait rien...
Le new code :Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Or Target.Row < 6 Or Target.Column <> 11 And Target.Column <> 13 Then Exit Sub 'si impaire If Target.Row And 1 Then If Cells(Target.Row - 1, "K").Value - Cells(Target.Row, "K").Value > 2 Then MsgBox "POINT DE CONSIGNE TEMP SÈCHE NON RESPECTÉ" End If End If End Sub -
-
