Liste déroulante avec check list et supression

Bérel Kaëlig

XLDnaute Nouveau
Bonjour à toutes et à tous;
Je n'arrive pas à faire une chose avec mes liste déroulante ( avec validation de formule et gestion de nom )
Je renseigne dans ma feuille "donnee" le nom des pièces de la cellule B3 à B21 les valeurs suivante:
Bureau 2
Bureau 3
Bureau 4
Bureau 5
Bureau 6
Bureau 7
Bureau 8
Bureau 9
Bureau 10
Bureau 11
Bureau 12
Bureau 13
Bureau 14
Bureau 15
Bureau 16
Bureau 17
Bureau 18
Bureau 19
Bureau 20

Et dans les cellules C3 à C21 mes prises réseaux:

T03
I03
T04
I04
T05
I05
T06
I06
T07
I07
T08
I08
T09
I09
T10
I10
T11
I11
T12

Je veux que quand je sélectionne dans la cellule B3 "Bureau 1" de ma feuille "Identification" il me fasse un check de ma liste déroulante où se trouve le nom "Bureau 1" et dans C3 il me mette une liste déroulante avec les informations concernant le nom "bureau 1". Et aussi quand je choisi "T03" ou "I03" il m'efface un de mes choix quand je le sélectionne
Je vous met à disposition un fichier ci-joint
icon_smile.gif

Merci pour votre aide
icon_smile.gif

Bonne journée
Kaeligb
 

Pièces jointes

  • Kaeligb.xlsx
    9.7 KB · Affichages: 27

vgendron

XLDnaute Barbatruc
il faut quand meme adapter le code à ton fichier....
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Range("AK:AL"), Target) Is Nothing And Target.Count = 1 Then 'si tu modifies ailleurs quand dans les colonnes AK et AL
   [AK3:AL1000].Sort Key1:=[AK3], Key2:=[AL3] 'tri des colonnes AK et AL
   '[AK3:AK1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[AM3], Unique:=True 'partie extraction sans doublon de la colonne AK vers AM
 End If
End Sub
 

Bérel Kaëlig

XLDnaute Nouveau
il faut quand meme adapter le code à ton fichier....
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("AK:AL"), Target) Is Nothing And Target.Count = 1 Then 'si tu modifies ailleurs quand dans les colonnes AK et AL
   [AK3:AL1000].Sort Key1:=[AK3], Key2:=[AL3] 'tri des colonnes AK et AL
   '[AK3:AK1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[AM3], Unique:=True 'partie extraction sans doublon de la colonne AK vers AM
End If
End Sub
Ca fait rien renvoie le fichier avec tous qui fonctionne stp :)
 

Bérel Kaëlig

XLDnaute Nouveau
il faut quand meme adapter le code à ton fichier....
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("AK:AL"), Target) Is Nothing And Target.Count = 1 Then 'si tu modifies ailleurs quand dans les colonnes AK et AL
   [AK3:AL1000].Sort Key1:=[AK3], Key2:=[AL3] 'tri des colonnes AK et AL
   '[AK3:AK1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[AM3], Unique:=True 'partie extraction sans doublon de la colonne AK vers AM
End If
End Sub
Merci beaucoup tout fonctionne je met ce Sujet en clos :)
 

Bérel Kaëlig

XLDnaute Nouveau
il faut quand meme adapter le code à ton fichier....
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("AK:AL"), Target) Is Nothing And Target.Count = 1 Then 'si tu modifies ailleurs quand dans les colonnes AK et AL
   [AK3:AL1000].Sort Key1:=[AK3], Key2:=[AL3] 'tri des colonnes AK et AL
   '[AK3:AK1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[AM3], Unique:=True 'partie extraction sans doublon de la colonne AK vers AM
End If
End Sub
Vois tu dans mon fichier pourquoi il me met AC BUREAU 1 en doublons ? :)
 

vgendron

XLDnaute Barbatruc
Pour clore le sujet...
en PJ

Dans le code de la feuille Data - qui se déclenche dès que tu modifies quelque chose dans les colonnes AK ou AL
macro qui tri par ordre alphabétique la colonne AK puis AL ==> les pièces Batiments sont regroupées par nom...

dans la colonne AM: une formule Matricielle pour extraire SANS doublon la colonne AK
cette colonne sert à alimneter la zone nommée: "List_Of_Pieces"
Feuille TableauRecap
colonne G: Liste de validation avec "List_Of_Pieces
Colonne H: Liste de validation avec formule permettant d'avoir toutes les prises possibles de la pièce sélectionnée..
 

Pièces jointes

  • KaeligVBA.xlsm
    125.6 KB · Affichages: 32

Bérel Kaëlig

XLDnaute Nouveau
J'ai résolu mes problème merci il fallait juste mettre dans le code VBA
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Range("AK:AL"), Target) Is Nothing And Target.Count = 1 Then
    [AK3:AL1000].Sort Key1:=[AK3], Key2:=[AL3]
    [AK4:AK1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[AM3], Unique:=True
  End If
End Sub
Et pour le doublons Secrétariat j'ai mal écris les deux noms ................. LOOOL

Merci à tous :)
KB
 

Discussions similaires

Statistiques des forums

Discussions
312 108
Messages
2 085 369
Membres
102 875
dernier inscrit
Jimbo2374