Effacer le contenu d'une cellule quand une autre est vide VBA

Fermé

lilounice Messages postés 31 Date d'inscription dimanche 16 février 2014 Statut Membre Dernière intervention 27 juillet 2015 - Modifié par jordane45 le 21/07/2015 à 16:23
eriiic Messages postés 24569 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 28 décembre 2023 - 27 juil. 2015 à 15:44

Bonjour,
j'ai ces quelques lignes VBA pour me palcer automatiquement des dates:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 4 Then
Target.Offset(0, 1) = Date
Target.Offset(0, 5) = Date + Range("J4").Value
Target.Offset(0, 9) = Date + Range("N4").Value
Target.Offset(0, 13) = Date + Range("R4").Value
End If

Le problème c'est que comme c'est sur change même lorsque Column4 = 0 la date est mise

J'aimerais rajouter une condition qui dit que quand column4 = "" alors target.offset(0,1) = ""

J'ai essayé mais sans succes donc si vous pouviez m'aider, ce serait cool merci!

EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici :
https://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code

Merci d'y penser dans tes prochains messages.
.

A voir également:

Effacer le contenu d'une cellule quand une autre est vide VBA
Aller à la ligne dans une cellule excel - Guide
Comment effacer une page sur word - Guide
Bloquer une cellule excel - Guide
Mettre une cellule en couleur si une autre cellule est vide ✓ - Forum Excel
Formate pour taxer client frigo vide ✓ - Forum Matériel & Système

9 réponses

Réponse 1 / 9

jordane45 Messages postés 38138 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 17 avril 2024 4 649
21 juil. 2015 à 16:24

Bonjour,

J'aimerais rajouter une condition qui dit que quand column4 = "" alors target.offset(0,1) = ""

 if target.value ="" Then target.offset(0,1) = ""

lilounice Messages postés 31 Date d'inscription dimanche 16 février 2014 Statut Membre Dernière intervention 27 juillet 2015 1
21 juil. 2015 à 17:47

Merci mais j'avais déjà essayé mais cça ne fonctionne pas, la date s'inscrit dans target.offset dans tous les cas
Je ne comprend pas du tout pourquoi...

Réponse 2 / 9

Le Pingou Messages postés 12035 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 1 avril 2024 1 425
Modifié par Le Pingou le 22/07/2015 à 10:51

Bonjour,
C'est peut-être cela que vous cherchez :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 4 Then
    If Target.Value <> 0 Then
        Target.Offset(0, 1) = Date
        Target.Offset(0, 5) = Date + Range("J4").Value
        Target.Offset(0, 9) = Date + Range("N4").Value
        Target.Offset(0, 13) = Date + Range("R4").Value
    Else
        Target.Offset(0, 1) = ""
        Target.Offset(0, 5) = ""
        Target.Offset(0, 9) = ""
        Target.Offset(0, 13) = ""
    End If
End If
Application.EnableEvents = True
End Sub

Salutations.
Le Pingou

Réponse 3 / 9

lilounice Messages postés 31 Date d'inscription dimanche 16 février 2014 Statut Membre Dernière intervention 27 juillet 2015 1
Modifié par lilounice le 22/07/2015 à 15:36

j'avais fait presque pareil


If Target.Column = 4 And Target.Value <> 0 Then
Target.Offset(0, 1) = Date
Target.Offset(0, 5) = Date + Range("J4").Value
Target.Offset(0, 9) = Date + Range("N4").Value
Target.Offset(0, 13) = Date + Range("R4").Value
End If
If Target.Column = 4 And Target.Value = 0 Then
Target.Offset(0, 1) = ""
Target.Offset(0, 5) = ""
Target.Offset(0, 9) = ""
Target.Offset(0, 13) = ""
End If

Je viens d'essayer ce code avec else mais ça fait planter excel, je veux dire tout le programme pas le code
De plus avec mon code j'ai un probleme lorsque je supprime une seule entrée (que ce soit target.column ou target.offset)
Mais lorsque j'en supprime plusieurs le code bug et me met en surbrillance la ligne


If Target.Column = 4 And Target.Value <> 0 Then

Réponse 4 / 9

Le Pingou Messages postés 12035 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 1 avril 2024 1 425
22 juil. 2015 à 17:11

Bonjour,
Je vous ai proposé un code que j'ai testé et qui fonctionne et ceci sans modification.
Le minimum serait de l'essayer sans oublie bonjour et salutations.
Libre à vous de ne pas le faire.

lilounice Messages postés 31 Date d'inscription dimanche 16 février 2014 Statut Membre Dernière intervention 27 juillet 2015 1
Modifié par lilounice le 22/07/2015 à 17:52

Bonjour!
Biensur que le minimum était de l'essayer! Et je l'ai fait
Peut être que je me suis mal exprimé mais il s'agit de votre code qui a fait planter mon excel

Pour la forme il est vrai que j'ai oublié la politesse élémentaire, j'ai communiqué par écrit comme si c'était à l'oral, une erreur de ma part

En tous cas je vous suis sincèrement reconnaissant à vous et autres membres du forum de l'aide précieuse et gratuite que vous m'apportez.

Milles excuses et Salutations !

lilounice Messages postés 31 Date d'inscription dimanche 16 février 2014 Statut Membre Dernière intervention 27 juillet 2015 1 > lilounice Messages postés 31 Date d'inscription dimanche 16 février 2014 Statut Membre Dernière intervention 27 juillet 2015
22 juil. 2015 à 17:52

Dans la précipitation je n'avait pas copié une ligne de votre code, qui en effet fonctionne.
Cependant il présente le même problème que cité précédemment , en cas de suppression simultanée de plusieurs entrées une erreur d'exécution "incompatibilité de type s'affiche"

Sauriez vous ce qui cloche ?

ReSalutations!

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 9

Le Pingou Messages postés 12035 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 1 avril 2024 1 425
22 juil. 2015 à 17:42

Bonjour,
De la peine à vous croire car il y a aucune raison que cela fonctionne chez moi et des erreurs chez vous.
Vous pouvez toujours mettre le fichier sur https://www.cjoint.com/ et poster le lien et comme cela on trouvera ou le chat à mal à la patte.

Réponse 6 / 9

Le Pingou Messages postés 12035 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 1 avril 2024 1 425
22 juil. 2015 à 17:49

Bonjour,
Mon fichier test : http://www.cjoint.com/c/EGwpW7nQCqY

Réponse 7 / 9

Le Pingou Messages postés 12035 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 1 avril 2024 1 425
22 juil. 2015 à 18:15

Bonjour,
Une possibilité dans le message 8 ....!

Réponse 8 / 9

Le Pingou Messages postés 12035 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 1 avril 2024 1 425
22 juil. 2015 à 22:25

Bonjour,
C'est dur de recevoir des informations : Sauriez-vous ce qui cloche ?

Si vous ne voulez pas mettre le fichier à disposition alors au minimum, le message d'erreur et son numéro et sur quelle ligne de code est-il arrêtée (surligner en jaune)

lilounice Messages postés 31 Date d'inscription dimanche 16 février 2014 Statut Membre Dernière intervention 27 juillet 2015 1
27 juil. 2015 à 12:16

Bonjour

Sur l'erreur qui s'affiche lorsque je supprime en même temps toutes les entrées de la colonne D est "erreur d'execution 13" incompatibilité de type
Dans le débogage c'est la ligne 4 qui est surlignée
Idem sur votre fichier test sur ci joint

PS: je comprend que sur internet il est important de se montrer courtois et précis, étant en 6 eme année de medecine je donne parfois des conseils sur des forums dans mon domaine. Mais vous ne pouvez en vouloir au néophytes que vous conseillez d'être justement des néophytes! Donc pardonnez ma formulation.

J'ai essayé votre fichiez test, il fonctionne mais ce même bug lors des suppressions multiples subsiste.

En tous cas merci de votre aide

eriiic Messages postés 24569 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 28 décembre 2023 7 211
Modifié par eriiic le 27/07/2015 à 15:39

Bonjour,

à partir du code de le pingou :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim pl As Range, c As Range
    Application.EnableEvents = False
    set pl = Intersect(Target, [D:D])
    If Not pl Is Nothing Then
        For Each c In pl
            If c.Value <> 0 Then
                c.Offset(0, 1) = Date
                c.Offset(0, 5) = Date + Range("J4").Value
                c.Offset(0, 9) = Date + Range("N4").Value
                c.Offset(0, 13) = Date + Range("R4").Value
            Else
                c.Offset(0, 1) = ""
                c.Offset(0, 5) = ""
                c.Offset(0, 9) = ""
                c.Offset(0, 13) = ""
            End If
        Next c
    End If
    Application.EnableEvents = True
End Sub

à tester...
eric

Réponse 9 / 9

Le Pingou Messages postés 12035 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 1 avril 2024 1 425
27 juil. 2015 à 15:32

Bonjour lilounice,
Merci pour l'information.
Merci eriiic (il me donne une petite erreur sur : pl = Intersect(Target, [D:D]) ....je cherche le pourquoi...)
Entre temps j'avais préparé ce qui suit :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pl As Range, c As Range
Application.EnableEvents = False
If Target.Column = 4 Then
        For Each c In Target
            If c.Value <> 0 Then
                c.Offset(0, 1) = Date
                c.Offset(0, 5) = Date + Range("J4").Value
                c.Offset(0, 9) = Date + Range("N4").Value
                c.Offset(0, 13) = Date + Range("R4").Value
            Else
                c.Offset(0, 1) = ""
                c.Offset(0, 5) = ""
                c.Offset(0, 9) = ""
                c.Offset(0, 13) = ""
            End If
        Next c
    End If
    Application.EnableEvents = True
End Sub

eriiic Messages postés 24569 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 28 décembre 2023 7 211
Modifié par eriiic le 27/07/2015 à 15:45

Salut le pingou

Ah oui, c'est set pl = Intersect(Target, [D:D])
J'aurais pu tester, merci ;-)
Et pour faire bonne mesure ajouter au début :
Application.ScreenUpdating = False

eric

Discussions similaires

Comment faire le symbole coeur vide/coeur blanc

le frigo ne marche pas....

Excel : colorer une cellule sous condition d'une autre ?

Excel VBA : Récupérer la valeur d'une cellule

Remplir une cellule (texte) en fonction d'une autre (texte).

Discussions similaires

Newsletters