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 - 24 nov. 2011 à 19:07

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?

Afficher la suite

A voir également:

Soustraction en loupe vba
Loupe grossissante gratuite - Télécharger - Divers Photo & Graphisme
Loupe windows - Guide
Excel compter cellule couleur sans vba - Guide
Activer la loupe sur android - Guide
Addition et soustraction dans la meme formule excel - Forum Excel

2 réponses

Réponse 1 / 2

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

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

Réponse 2 / 2

lanetmel Messages postés 200 Date d'inscription Statut Membre Dernière intervention 4

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

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

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

lanetmel Messages postés 200 Date d'inscription Statut Membre Dernière intervention 4

Encore merci! ça fonctionne parfaitement!

Discussions similaires

soustraction dans excel

"L'indice n'appartient à la sélection" + VBA

Erreur d'exécution 13 Incompatibilité de type

formule excel de soustraction selon condition

appliquer une pause dans une macro vba excel

Votre réponse

Discussions similaires