Supprimer un élément d'une liste déroulante après l'avoir choisi

[Bérel Kaëlig]

Bonjour
Je ne trouve pas de réponses à ma question pourtant je pense qu'il en existe pleins.
J'ai des listes déroulante prenons exemple sur la cellule "H4".
J'ai ma liste déroulante avec deux valeurs "I03" et "T03", j'aimerai que quand je sélectionne "I03" et que ça l'affiche dans ma case je veux qu'il soit effacer et qu'il y ai que "T03" dans cette liste.
J'ai utilisé les validation de donnée dans ma cellule H4 voici la formule:

=DECALER(List_of_prises_reseaux;EQUIV(G4;List_of_pieces_batiments;0)-1;0;NB.SI(List_of_pieces_batiments;G4))

Pouvez-vous adapter cette formule pour répondre à ma question s'il vous plait
Bonne journée
Kaelig

 

[idylh]

Bonjour,
Vous trouverez peut-être votre bonheur sur ce site
http://boisgontierjacques.free.fr/pages_site/donneesvalidation.htm#ListeDiff

 

[Bérel Kaëlig]

Bonjour,
Vous trouverez peut-être votre bonheur sur ce site
http://boisgontierjacques.free.fr/pages_site/donneesvalidation.htm#ListeDiff

Merci !

 

[job75]

Bonsoir Bérel Kaëlig, idylh,

Je ne sais pas si BOISGONTIER a traité ce problème, en tout cas voici une solution.

Coller cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel1 As Range, cel2 As Range, P1 As Range, P2 As Range, i As Variant, r As Range, f$
Set cel1 = [G4]: Set cel2 = [H4] 'cellules à adapter
Set P1 = [List_of_prises_reseaux]: Set P2 = [List_of_pieces_batiments] 'plages à adapter
If Not Intersect(Target, cel1) Is Nothing Then
    i = Application.Match(cel1, P2, 0)
    If IsNumeric(i) Then
        Set r = P1(i).Resize(Application.CountIf(P2, cel1))
        For Each r In r: f = f & "," & r: Next 'concaténation
    End If
    With cel2.Validation
        .Delete
        If f <> "" Then .Add xlValidateList, Formula1:=f
    End With
ElseIf Not Intersect(Target, cel2) Is Nothing Then
    On Error Resume Next 'si la formule de validation n'existe pas
    With cel2.Validation
        f = .Formula1
        .Delete
        .Add xlValidateList, Formula1:=Replace(Replace(f, cel2, ""), ";", ",")
    End With
End If
End Sub

Commencer par modifier ou (re)valider la cellule G4 : cela crée la liste de validation en H4.

Ensuite modifier H4 : la liste se réduit à chaque fois.

Comme on pourra le voir la liste en H4 n'est pas définie par une formule.

A+

 

[job75]

Bonjour Bérel Kaëlig, le forum,

Une solution beaucoup plus élaborée avec création d'une liste de validation en G4 :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cel As Range, r As Range, d As Object, f$
Set cel = [G4] 'cellule à adapter
Set r = [List_of_pieces_batiments] 'plage à adapter
If Not Intersect(Target, cel) Is Nothing Then
    With cel.Validation
        .Delete
        Set d = CreateObject("Scripting.Dictionary")
        For Each r In r
            If r <> "" Then If Not d.exists(r.Value) Then _
                d(r.Value) = "": f = f & "," & r 'concaténation
        Next
        If d.Count Then .Add xlValidateList, Formula1:=f 'création de la liste en G4
        cel = cel 'création de la liste en H4
    End With
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel1 As Range, cel2 As Range, P1 As Range, P2 As Range, i As Variant, r As Range, f$
Set cel1 = [G4]: Set cel2 = [H4] 'cellules à adapter
Set P1 = [List_of_prises_reseaux]: Set P2 = [List_of_pieces_batiments] 'plages à adapter
If Not Intersect(Target, Union(P1, P2)) Is Nothing Then 'création des listes en G4 et H4
    Worksheet_SelectionChange cel1
    If Not Intersect(Target, P2) Is Nothing Then cel1 = ""
ElseIf Not Intersect(Target, cel1) Is Nothing Then 'création de la liste en H4
    i = Application.Match(cel1, P2, 0)
    If IsNumeric(i) Then
        Set r = P1(i).Resize(Application.CountIf(P2, cel1))
        For Each r In r: f = f & ",," & r: Next 'concaténation avec double séparateur
        f = f & ","
    End If
    With cel2.Validation
        .Delete
        If f <> "" Then .Add xlValidateList, Formula1:=f
    End With
    cel2 = "" 'RAZ
ElseIf Not Intersect(Target, cel2) Is Nothing And CStr(cel2) <> "" Then 'réduction de la liste en H4
    On Error Resume Next 'si Formula1 n'existe pas
    With cel2.Validation
        f = .Formula1
        .Delete
        .Add xlValidateList, Formula1:=Replace(Replace(f, ";", ","), "," & CStr(cel2) & ",", "")
    End With
End If
End Sub

Pour être sûr qu'il n'y ait pas de problème lors de la réduction de la liste en H4 il faut doubler les séparateurs pour bien isoler les éléments.

Fichier joint.

Bonne journée.

 

[job75]

Re,

S'il y a plusieurs cellules à traiter en colonnes G et H il faut ajouter des boucles pour les cas de sélections ou d'entrées multiples :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim P As Range, r As Range, d As Object, f$
Set P = [G4:H10] 'plage à adapter
Set r = [List_of_pieces_batiments] 'plage à adapter
If Not Intersect(Target, P.Columns(1)) Is Nothing Then
    For Each Target In Intersect(Target, P.Columns(1)).Areas 'si sélections multiples
        With Target.Validation
            .Delete
            If d Is Nothing Then
                Set d = CreateObject("Scripting.Dictionary")
                For Each r In r
                    If r <> "" Then If Not d.exists(r.Value) Then _
                        d(r.Value) = "": f = f & "," & r 'concaténation
                Next r
            End If
            If d.Count Then .Add xlValidateList, Formula1:=f 'création des listes en colonne G
            Target = Target.Value 'création des listes en colonne H
        End With
    Next Target
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, P1 As Range, P2 As Range, c As Range, f$, i As Variant, r As Range
Set P = [G4:H10] 'plage à adapter
Set P1 = [List_of_prises_reseaux]: Set P2 = [List_of_pieces_batiments] 'plages à adapter
If Not Intersect(Target, Union(P1, P2)) Is Nothing Then 'création des listes en colonnes G et H
    Worksheet_SelectionChange P
    If Not Intersect(Target, P2) Is Nothing Then P.Columns(1) = ""
End If
If Not Intersect(Target, P.Columns(1)) Is Nothing Then 'création des listes en colonne H
    For Each c In Intersect(Target, P.Columns(1)) 'si entrées multiples
        f = ""
        i = Application.Match(c, P2, 0)
        If IsNumeric(i) Then
            Set r = P1(i).Resize(Application.CountIf(P2, c))
            For Each r In r: f = f & ",," & r: Next r 'concaténation avec double séparateur
            f = f & ","
        End If
        With c(1, 2).Validation
            .Delete
            If f <> "" Then .Add xlValidateList, Formula1:=f
        End With
        c(1, 2) = "" 'RAZ
    Next c
End If
If Not Intersect(Target, P.Columns(2)) Is Nothing Then 'réduction des listes en colonne H
    On Error Resume Next 'si Formula1 n'existe pas
    For Each c In Intersect(Target, P.Columns(2)) 'si entrées multiples
        If CStr(c) <> "" Then
            With c.Validation
                f = ""
                f = .Formula1
                .Delete
                .Add xlValidateList, Formula1:=Replace(Replace(f, ";", ","), "," & CStr(c) & ",", "")
            End With
        End If
    Next c
End If
End Sub

Fichier (2).

A+

 

[riton00]

Bonsoir
Je ne sais pas si j'ai bien pigé ton truc, mais peut-être comme ça....

 

[job75]

Bonsoir riton00,

Je ne sais pas si j'ai bien pigé ton truc, mais peut-être comme ça....

Non, vous n'avez pas pigé le truc, il suffit de lire le post #1 et de comprendre la formule qui s'y trouve.

La validation des données en H4 doit s'appuyer sur G4 et sur 2 plages de données List_of_prises_reseaux et List_of_pieces_batiments.

C'est clair sur les fichiers que j'ai joints.

A+

 

[job75]

Bonjour le forum,

Petite modification aux 2 fichiers précédents : l'effacement de la colonne G quand on modifie P2.

Bon dimanche.