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

17aalex85-v10.xlsm (29.14 Ko)

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 ! 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

Rechercher des sujets similaires à "supprimer valeurs valeur supprime liste"