Supprimer valeurs cellules si valeur supprimé de la liste
Bonjour à tous,
J'y suis presque arrivé mais j'ai encore besoin un peu de votre aide pour terminer mon code.
Dans mon classeur Excel ci-joint, il me reste à ajouter une fonction qui doit supprimer certaines valeurs contenues dans différentes feuilles si une des valeurs a été supprimée des cellules de référence alimentant les listes de choix.
Merci d'avance pour votre aide
aalex85
Bonsoir,
voici le code (après édition car l'ancien ne marchait pas !):
Application.EnableEvents = False
Sheets("Feuil1").Select
For Each C In ZoneTest1
If C.Value <> "" Then
If Trim(C.Value) = TargetOld Then
C.Value = TargetNew
If TargetNew = "" Then
C.Offset(0, -4).Value = ""
C.Offset(0, -3).Value = ""
C.Offset(0, -2).Value = ""
C.Offset(0, -1).Value = ""
Selection.ClearContents
End If
End If
End If
Next C
For Each C In ZoneTest2
If C.Value <> "" Then
If Trim(C.Value) = TargetOld Then
C.Value = TargetNew
If TargetNew = "" Then
C.Offset(0, -4).Value = ""
C.Offset(0, -3).Value = ""
C.Offset(0, -2).Value = ""
C.Offset(0, -1).Value = ""
End If
End If
End If
Next C
For Each C In ZoneTest3
If C.Value <> "" Then
If Trim(C.Value) = TargetOld Then
C.Value = TargetNew
If TargetNew = "" Then
C.Offset(0, -4).Value = ""
C.Offset(0, -3).Value = ""
C.Offset(0, -2).Value = ""
C.Offset(0, -1).Value = ""
End If
End If
End If
Next C
For Each C In ZoneTest4
If C.Value <> "" Then
If Trim(C.Value) = TargetOld Then
C.Value = TargetNew
If TargetNew = "" Then
C.Offset(0, -4).Value = ""
C.Offset(0, -3).Value = ""
C.Offset(0, -2).Value = ""
C.Offset(0, -1).Value = ""
End If
End If
End If
Next C
Application.EnableEvents = True
ne pas oublier Application.EnableEvents = False car quand on modifie une valeur sur une feuille sans mettre à False, la fonction événementielle Change est lancée et votre code est dans cette fonction événementielle !!! donc vous re-rentrer dedans etc etc
If TargetNew = "" Then
C.Offset(0, -4).Value = ""
C.Offset(0, -3).Value = ""
C.Offset(0, -2).Value = ""
C.Offset(0, -1).Value = ""
End If
Après avoir modifié les cellule en fond jaune, on teste la valeur nouvelle qu'on vient d'inscrire, si c'est égal à rien, on a effacé donc on va de la cellule même ligne - 4 colonne à même ligne -1 colonne et on efface les données, on peut très bien mettre clearcontent...
@ bientôt
LouReeD
Bonjour LouReeD;
Merci pour ta réponse
Je viens de tester le code que tu m'as envoyé
Je te confirme qu'il fonctionne exactement comme je le souhaitais.
Par contre quand je supprime une valeur dans les cellules jaunes de la "feuil5" les valeurs correspondantes sur les "feuils1" à "feuil4" sont bien supprimées ainsi que les valeurs placées sur la même ligne colonne ABCD pour chaque feuille
Par contre le code erreur 91 s'affiche et ce place à la fin du code sur
C.Offset(0, -4).Value = ""
Merci
aalex85
Bonsoir,
sur le fichier joint je ne rencontre pas ce genre d'erreur...
Essayez voir, après l'erreur 91 est souvent une erreur de définition de variable ou d'assignation de valeur, regardez si vous n'avez pas fait de faute de frappe dans votre code.
@ bientôt
LouReeD
Bonsoir LouReed,
Je confirme, il y avait une ligne de trop sur mon code...
Je viens donc de tester votre code qui fonctionne parfaitement
Encore merci pour votre aide et les quelques commentaires que vous avez ajoutez pour le bon déroulement du code
Cordialement
aalex85
Et n'oubliez pas :
@ bientôt (très) sur le forum
LouReeD
Bonjour à tous,
J'ouvre de nouveau cette discussion car je souhaite apporter une petite modification à mon code
Sur la feuille 5 de mon classeur j'ai une plage de cellule référence alimentant des listes de choix placées sur
les feuilles: "feuil1 à feuil4"
Pour le moment lorsque je modifie ou supprime une valeur des cellules références de la "feuil5" alors les valeurs correspondantes
qui ont été choisies à partir des listes de choix (feuil1 à feuil5) sont automatiquement mises à jour.
Je souhaiterais que dans le cas ou une valeur des cellules de références (feuil5) est supprimée alors les cellules contenant ces valeurs,
qui avaient choisies à partir des listes de choix (feuil1 à feuil5) ne soient pas vide mais automatiquement remplacées par un "\"
Voir fichier ci-joint
Merci d'avance pour votre aide
aalex85
Bonjour !
bonsoir, et de retour !
Ci dessous le code complet de la Sub Change :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ZoneTest1 As Range, ZoneTest2 As Range, ZoneTest3 As Range, ZoneTest4 As Range, C As Range, TargetNew, TargetOld
'Modifier la liste de référence "C2:C10" et de mettre à jour la
'Nouvelle valeurs choisies dans la liste déroulante sur "feuil1 à feuil4
If Not Intersect(Range("C10:C20"), Target) Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
'Set ZoneTest1 = Sheets("Feuil1").Range("A1:A2")
Set ZoneTest1 = Sheets("Feuil1").Range("E10:E25")
Set ZoneTest2 = Sheets("Feuil2").Range("E10:E25")
Set ZoneTest3 = Sheets("Feuil3").Range("E10:E25")
Set ZoneTest4 = Sheets("Feuil4").Range("E10:E25")
TargetNew = Trim(Target)
Application.Undo
TargetOld = Trim(Target)
Target = TargetNew
'Modifier ou supprimer les valeurs contenues dans les cellules de référence C2 à C10 et supprime espace en début de cellule
If MsgBox("Vous aller modifier le nom du projet ou le supprimer" & vbCr & vbCr & "VOULEZ VOUS CONTINUER ?", vbCritical + vbYesNo, "ATTENTION") <> vbYes Then
Target = TargetOld
TargetNew = Target
End If
'Modifie ou supprimme automatiquement les valeurs des cellules de la plage "E10:E25" sur "feuil1" à "feuil4"
'si les cellules de références sont modifiées ou supprimées sur "feuil5"
Application.EnableEvents = False
Sheets("Feuil1").Select
For Each C In ZoneTest1
If C.Value <> "" Then
If Trim(C.Value) = TargetOld Then
C.Value = TargetNew
If TargetNew = "" Then
C.Offset(0, -4).Value = ""
C.Offset(0, -3).Value = ""
C.Offset(0, -2).Value = ""
C.Offset(0, -1).Value = ""
Selection.ClearContents
C.Value = "/"
End If
End If
End If
Next C
For Each C In ZoneTest2
If C.Value <> "" Then
If Trim(C.Value) = TargetOld Then
C.Value = TargetNew
If TargetNew = "" Then
C.Offset(0, -4).Value = ""
C.Offset(0, -3).Value = ""
C.Offset(0, -2).Value = ""
C.Offset(0, -1).Value = ""
C.Value = "/"
End If
End If
End If
Next C
For Each C In ZoneTest3
If C.Value <> "" Then
If Trim(C.Value) = TargetOld Then
C.Value = TargetNew
If TargetNew = "" Then
C.Offset(0, -4).Value = ""
C.Offset(0, -3).Value = ""
C.Offset(0, -2).Value = ""
C.Offset(0, -1).Value = ""
C.Value = "/"
End If
End If
End If
Next C
For Each C In ZoneTest4
If C.Value <> "" Then
If Trim(C.Value) = TargetOld Then
C.Value = TargetNew
If TargetNew = "" Then
C.Offset(0, -4).Value = ""
C.Offset(0, -3).Value = ""
C.Offset(0, -2).Value = ""
C.Offset(0, -1).Value = ""
C.Value = "/"
End If
End If
End If
Next C
If TargetNew = "" Then
Sheets("Feuil5").Select
With Sheets("Feuil5")
For i = 20 To 10 Step -1
If .Cells(i, 3).Value = "" Then
.Cells(i, 3).Delete Shift:=xlUp
End If
Next i
End With
Range("C10:C20").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("C10").Select
End If Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub
En surligner ce qu'il y a à ajouter.
En simple : si on efface les données des cellules de droites c'est qu'on a effacé une des valeurs de la liste de la feuille5 donc en cellule de test des feuilles 1 à 4 "C" on inscrit la valeur /
Ensuite il y a le ScreenUpDating à False et True pour éviter que l'écran scintille.
Puis une fois la valeur supprimer la case vide est supprimée de la liste de choix, c'est plus propre...
@ bientôt
LouReeD
Bonsoir
Ce sujet ressemble furieusement à un sujet auquel j'ai répondu
Bonsoir ! 64 !
Oui mais ici c'est en moins pro !
Je n'arrivais pas à trouver le :
C.Offset(0, -4).Resize(, 4).ClearContents
pour effacer d'un seul coup les 4 cellules !!!
Merci à vous.
De mon coté j'ai ajouté un module pour effacer la cellule vide de la liste de choix, mais il doit y avoir plus propre pour le faire, non?
@ bientôt
LouReeD