XL 2010 VBA changer valeur celulle en fonction de plusieurs cellules

sims

XLDnaute Nouveau
Bonjour à tous !

J'ai cherché un peu partout mais je ne trouve pas comment réaliser ma macro ...

Je cherche à implémenter une macro qui change la valeur des cellules d'une colonne en fonction de la valeur des cellules de plusieurs colonnes.

Exemple pour la ligne 9 :

Ma cellule à changer est E9,

C'est le dernier évènement qui devra mettre à jour le statut de la liste déroulante en cellule E9

Si C9 est renseignée donc E9 = "encours" (on ne teste pas les autres cellules)
Si D9 < date du jour et C9 ="" et F9="" donc E9 = "non recetté"
Si F9 et C9 sont renseignés donc E9 = "OK"
Si C9 est renseigné et J9, P9, V9, AB9, ou AH9 est renseigné donc E9 = "NOK"

Le fichier doit permettre l'utilisation suivante :

- Je renseigne une date en C9, on passe le statut en E9 à en cours
- Si aucune date n'est renseignée en C9 et F9 et que la date du jour > D9, on passe le statut en E9 à non recetté (on a dépassé la date prévisionnelle de fin de recette sans commencer le scénario)
- Je renseigne une date de fin en F9 et une date de début est renseignée en C9, on passe le statut en E9 à OK (scénario commencé et finalisé, mais si on retouche aux cellules J9, P9, V9, AB9, ou AH9 on repasse à NOK "et le luxe serait d'effacer la cellule F9")
- Si j'ai une date de début renseigné en C9 (Vrai même si la date de fin est renseignée en F9) et que les cellules J9, P9, V9, AB9, ou AH9 ne sont pas vides, on passe le statut en E9 à NOK.

Vous trouverez en PJ un fichier xlsm avec exemple de la ligne à tester

J'ai commencé à écrire un code par rapport à ce que j'ai trouvé sur le net mais je n'arrive pas à l'adapter pour tester plusieurs cellules :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [C:C]) Is Nothing And Target <> "" Then
 Target(1, 3) = "ENCOURS"
End If
End Sub

Merci beaucoup de votre aide !

Cdt,

Sims
 

Pièces jointes

  • Aide VBA.xlsm
    19.1 KB · Affichages: 38
Dernière édition:

vgendron

XLDnaute Barbatruc
Re : VBA changer valeur celulle en fonction de plusieurs cellules

Hello

Pourquoi ne pas utiliser une formule? en E9

=SI(F9<>"";"OK";SI(ET(C9<>"";AUJOURDHUI()>D9);"Non Recetté";"OK")*SI(OU(J9<>"";P9<>"";V9<>"";AB9<>"");"NOK"))

il va falloir revoir les conditions

si E9 est renseigné -->En cours
si date du jour >D9 -->E9 Non recette..
mais si E9 est renseigné ET date du jour >D9 --> ??????

etc etc
 

vgendron

XLDnaute Barbatruc
Re : VBA changer valeur celulle en fonction de plusieurs cellules

En fait. il faut définir ce que sont tes critères: OK nok...

NOK: à partir du moment où il y a quelque chose dans l'une des cases J P V AB, ce qui se traduit par: SI(OU(J9<>"";P9<>"";V9<>"";AB9<>"");"NOK")

En Cours: il y a juste une date de début ? ( et rien dans les autres)
Non recetté: ??? j'ai du mal à voir ce qui le distingue de En cours.. et de OK

OK: il y a une date en début et une en fin..

et donc. le cas ou la date du jour> D9... je vois pas ce que ca peut donner..
ex:
une date de début est présente au 17/07/2015
une date de fin est présente en F9: 20/06/2016
il y a donc début et fin. je dirais que c'est OK.. sauf que la date du jour (28/06/2016) est >> 20/06/2016.. c'est plus ok??
 

sims

XLDnaute Nouveau
Re : VBA changer valeur celulle en fonction de plusieurs cellules

En fait. il faut définir ce que sont tes critères: OK nok...

NOK: à partir du moment où il y a quelque chose dans l'une des cases J P V AB, ce qui se traduit par: SI(OU(J9<>"";P9<>"";V9<>"";AB9<>"");"NOK")

En Cours: il y a juste une date de début ? ( et rien dans les autres)
Non recetté: ??? j'ai du mal à voir ce qui le distingue de En cours.. et de OK

OK: il y a une date en début et une en fin..

et donc. le cas ou la date du jour> D9... je vois pas ce que ca peut donner..
ex:
une date de début est présente au 17/07/2015
une date de fin est présente en F9: 20/06/2016
il y a donc début et fin. je dirais que c'est OK.. sauf que la date du jour (28/06/2016) est >> 20/06/2016.. c'est plus ok??

Hello,

Merci de tes réponses, effectivement j'ai pas terminé de définir mes critères, (mea culpa)
De plus, je ne voulais pas uiliser les formules "si" qu'en ultime recours, car
- je souhaite garder la possibilité d'utiliser la liste déroulante
- Je souhaite que ce soit le dernier évènement qui mets à jour la cellule en E9 (même si j'ai une date de fin en F9 mais que la date de début en C9 change, le statut repasse à encours, de même si les autres cellules changent)

Je complète donc avec ceci et je l'ajoute dans le message initial :

C'est le dernier évènement qui devra mettre à jour le statut de la liste déroulante en cellule E9

Si C9 est renseignée donc E9 = "encours" (on ne teste pas les autres cellules)
Si D9 < date du jour et C9 ="" et F9="" donc E9 = "non recetté"
Si F9 et C9 sont renseignés donc E9 = "OK"
Si C9 est renseigné et J9, P9, V9, AB9, ou AH9 est renseigné donc E9 = "NOK"

Le fichier doit permettre l'utilisation suivante :

- Je renseigne une date en C9, on passe le statut en E9 à en cours
- Si aucune date n'est renseignée en C9 et F9 et que la date du jour > D9, on passe le statut en E9 à non recetté (on a dépassé la date prévisionnelle de fin de recette sans commencer le scénario)
- Je renseigne une date de fin en F9 et une date de début est renseignée en C9, on passe le statut en E9 à OK (scénario commencé et finalisé, mais si on retouche aux cellules J9, P9, V9, AB9, ou AH9 on repasse à NOK "et le luxe serait d'effacer la cellule F9")
- Si j'ai une date de début renseigné en C9 (Vrai même si la date de fin est renseignée en F9) et que les cellules J9, P9, V9, AB9, ou AH9 ne sont pas vides, on passe le statut en E9 à NOK.

J'espère être plus clair ...

Merci encore.
 

vgendron

XLDnaute Barbatruc
Re : VBA changer valeur celulle en fonction de plusieurs cellules

Essaie avec ce code..

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False

If Not Intersect(Target, [C:C]) Is Nothing And Target <> "" Then
    If [J9] <> "" Or [P9] <> "" Or [V9] <> "" Or [AB9] <> "" Or [AH9] <> "" Then
        [E9] = "NOK"
        Exit Sub
    End If
    If [C9] <> "" Then
        [E9] = "En Cours"
        Else
            If [D9] < Date And [F9] = "" Then
                [E9] = "Non recetté"
            Else
                If [F9] <> "" And [C9] <> "" Then
                    [E9] = "OK"
                End If
            End If
    End If
End If
Application.EnableEvents = True
End Sub
 

sims

XLDnaute Nouveau
Re : VBA changer valeur celulle en fonction de plusieurs cellules

Re,
Le code ne fonctionne que lorsque une cellule de la colonne C est renseignée mais pas quand les cellules des autres cellules sont renseignés,
J'imaginais un solution avec un Target.Offset(nbre ligne,nbre colonne) ou Target(indexligne,indexcolonne) pour arriver à la cellule à changer depuis la cellule testée.
Car cela doit fonctionner pour toutes les cellules de la colonne E en testant toutes les cellules des colonnes C; D; F; J; P; V; AB; AH
 

vgendron

XLDnaute Barbatruc
Re : VBA changer valeur celulle en fonction de plusieurs cellules

le code adapté pour qu'il fonctionne sur toutes les lignes

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False

If Not Intersect(Target, [C:C]) Is Nothing Then 'And Target <> "" Then
l = Target.Row
    If Cells(l, "J") <> "" Or Cells(l, "P") <> "" Or Cells(l, "V") <> "" Or Cells(l, "AB") <> "" Or Cells(l, "AH") <> "" Then
        
        Cells(l, "E") = "NOK"
        Application.EnableEvents = True
        Exit Sub
    End If
    If Cells(l, "C") <> "" Then
        Range(l, "E") = "En Cours"
        Else
            If Cells(l, "D") < Date And Cells(l, "F") = "" Then
                Cells(l, "E") = "Non recetté"
            Else
                If Cells(l, "F") <> "" And Cells(l, "C") <> "" Then
                    Cells(l, "E") = "OK"
                End If
            End If
    End If
End If
Application.EnableEvents = True
End Sub

pardon.. Range-->cells.. et manquait un Application.EnableEvents = True
 
Dernière édition:

sims

XLDnaute Nouveau
Re : VBA changer valeur celulle en fonction de plusieurs cellules

Désolé mais il ne se passe rien quand je remplis les lignes des colonnes (cellules) à tester
La macro ne se déclenche même plus lorsque je saisie dans les lignes de la colonne C ...
 

vgendron

XLDnaute Barbatruc
Re : VBA changer valeur celulle en fonction de plusieurs cellules

Grr..

il restait un Range..

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False

If Not Intersect(Target, [C:C]) Is Nothing Then 'And Target <> "" Then
l = Target.Row
    If Cells(l, "J") <> "" Or Cells(l, "P") <> "" Or Cells(l, "V") <> "" Or Cells(l, "AB") <> "" Or Cells(l, "AH") <> "" Then
        
        Cells(l, "E") = "NOK"
        Application.EnableEvents = True
        Exit Sub
    End If
    If Cells(l, "C") <> "" Then
        cells(l, "E") = "En Cours"
        Else
            If Cells(l, "D") < Date And Cells(l, "F") = "" Then
                Cells(l, "E") = "Non recetté"
            Else
                If Cells(l, "F") <> "" And Cells(l, "C") <> "" Then
                    Cells(l, "E") = "OK"
                End If
            End If
    End If
End If
Application.EnableEvents = True
End Sub

pour relancer les évènements.
lance cette macro une fois

Code:
sub relanceevent()
Application.EnableEvents = True
end sub
 

sims

XLDnaute Nouveau
Re : VBA changer valeur celulle en fonction de plusieurs cellules

C'est mieux :) ça change les cellules de la colonne E quand je modifie une cellule de la colonne C, mais toujours pas lorsque je remplis ou modifie une cellule des autres colonnes.

J'ai l'impression que le code teste les cellules de la colonne C en premier, c'est à dire si je ne modifie pas à chaque fois la cellule de la colonne C, il ne va pas plus loin.

On ne peut pas ajouter toutes les colonnes à tester dans le :
If Not Intersect(Target, [C:C], [D:D], etc.) ?
 

vgendron

XLDnaute Barbatruc
Re : VBA changer valeur celulle en fonction de plusieurs cellules

J'ai l'impression que le code teste les cellules de la colonne C en premier
tout à fait. c'est ce que tu as codé initialement..à peu près..
Code:
If Not Intersect(Target, [C:C]) Is Nothing Then

à peu près parce que j'ai enlevé
Code:
And Target <> ""
qui te sortait du code si C est vide.. c a d . que tu n'aurais pas eu le "Non recetté"

l'ennui. c'est qu'en enlevant cette partie. si tu cliques en dehors de ton tableau. du coup. tu as le "Non recetté". alors que tu ne le veux pas..
pour régler le problème. voir proposition ci dessous


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
Set zone = [B8].CurrentRegion

If Not Intersect(Target, zone) Is Nothing Then
l = Target.Row
    If Cells(l, "J") <> "" Or Cells(l, "P") <> "" Or Cells(l, "V") <> "" Or Cells(l, "AB") <> "" Or Cells(l, "AH") <> "" Then
        
        Cells(l, "E") = "NOK"
        Application.EnableEvents = True
        Exit Sub
    End If
    If Cells(l, "C") <> "" Then
        Cells(l, "E") = "En Cours"
        Else
            If Cells(l, "D") < Date And Cells(l, "F") = "" Then
                Cells(l, "E") = "Non recetté"
            Else
                If Cells(l, "F") <> "" And Cells(l, "C") <> "" Then
                    Cells(l, "E") = "OK"
                End If
            End If
    End If
End If
Application.EnableEvents = True
End Sub

Sub t()
Application.EnableEvents = True
End Sub
 

sims

XLDnaute Nouveau
Re : VBA changer valeur celulle en fonction de plusieurs cellules

Malheureusement ça ne fonctionne toujours pas ...

le code suivant
Code:
Set zone = [B8].CurrentRegion

"Bride" la macro qui ne se déclenche plus lorsque je saisi dans une autre cellule de la colonne C que C9...
De plus lorsque je change les autres cellules des colonnes F ou J etc. celà ne change pas la celule de la colonne E qui est sur la même ligne ...
Par ailleurs, les listes déroulantes des cellules de la colonne E ne sont plus sélectionnables ..

Au pire je mets une formule mais j'en ai tellement sur mon fichier initial que ça va commencer à faire usine à gaz sans que ça ne réponde réellement à mon besoin ...
 

vgendron

XLDnaute Barbatruc
Re : VBA changer valeur celulle en fonction de plusieurs cellules

"Bride" la macro
c'était l'idée..

ajoutte cette ligne de code
Code:
zone.Select

si tu as cliqué en dehors de la zone sélectionnée.. les calculs ne se feront pas. (la macro est lancée. puisque la zone est sélectionnée
si tu cliques n'importe ou dans la zone, les calculs se font. (que tu aies cliqué sur la colonne C, F ou ...

maintenant.. si malgré ca. la cellule E n'est pas modifiée. c'est que tes conditions telles qu'exprimées.. ne correspondent pas réellement à ton besoin..
 

vgendron

XLDnaute Barbatruc
Re : VBA changer valeur celulle en fonction de plusieurs cellules

Je te remet le code avec des commentaires sur chaque ligne, pour bien expliquer ce que chaque ligne fait. et pourquoi.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
' on désactive les evènements pour éviter de lancer la macro en boucle et ralentir l'ensemble
Application.EnableEvents = False

'on détecte la zone contenant des data
'à partir de B8 Excel cherche la zone délimitée par des colonnes et lignes entièrement vides

Set zone = [B8].CurrentRegion
zone.Select
'si le changement de valeur a eu lieu dans cette zone
If Not Intersect(Target, zone) Is Nothing Then
'on récupère le numéro de ligne de la cellule modifiée
l = Target.Row
    'si sur cette ligne, une des colonnes, J P V AB ou AH contient quelque chose..
    If Cells(l, "J") <> "" Or Cells(l, "P") <> "" Or Cells(l, "V") <> "" Or Cells(l, "AB") <> "" Or Cells(l, "AH") <> "" Then
        'alors en colonne E, on met NOK
        Cells(l, "E") = "NOK"
        Application.EnableEvents = True
        'et on sort. --> on ne regarde pas le contenu des autres colonnes (C D F)
        Exit Sub
    End If
    'si on arrive la. c'est que les colonnes précedentes sont vides
    'si en colonne C, il y a quelque chose
    If Cells(l, "C") <> "" Then
        'on met En cours en colonne E.. et puis c'est tout
        Cells(l, "E") = "En Cours"
        'sinon. = rien en colonne C
        Else
            'si colonne D est avant aujourdhui ET colonne F vide alors
            If Cells(l, "D") < Date And Cells(l, "F") = "" Then
                'E non recetté. et puis c'est tout
                Cells(l, "E") = "Non recetté"
            Else
                'si on arrive la. c'est que soit D est après aujourd'hui. soit F non vide
                'si F est non vide ET C non vide
                If Cells(l, "F") <> "" And Cells(l, "C") <> "" Then
                    'E est OK
                    Cells(l, "E") = "OK"
                End If
            End If
    End If
End If
Application.EnableEvents = True
End Sub
 

Discussions similaires