Liste selection multiple VBA

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Maud44
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
M

Maud44

Guest
Bonjour
J'ai un problème, je n'arrive pas à mettre dans une cellule plusieurs données d'une même liste déroulante...Par exemple faire apparaitre A , B , C dans une même cellule ... en partant de la liste déroulante A, B , C ,D
Malgré les codes existants je ne comprends pas le fonctionnement du codE...
Quel code faut - il réaliser?
D'avance merci,
Cordialement,
 

Pièces jointes

Trier par date Trier par votes
Re : Liste selection multiple VBA

Bonsoir,

Il n'y a pas besoin de colonne intermédiaire.

Cf Listes en cascade: choixs successifs


http://boisgontierjacques.free.fr/fichiers/DonneesValidation/DVChoixSuccessifs.xls
http://boisgontierjacques.free.fr/fichiers/DonneesValidation/DVChoixSuccessifs2.xls

Code: 
Choix successifs dans un menu 
les choix s'ajoutent ou se retranchent

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address = "$C$2" And Target.Count = 1 Then
    Application.EnableEvents = False
    ValSaisie = Target
    Application.Undo
    p = InStr(Target, ValSaisie)
    If p > 0 Then
      Target = Left(Target, p - 1) & Mid(Target, p + Len(ValSaisie) + 1)
      If Right(Target, 1) = Chr(10) Then
        Target = Left(Target, Len(Target) - 1)
      End If
    Else
        If Target = "" Then
          Target = ValSaisie
        Else
          Target = Target & Chr(10) & ValSaisie
        End If
    End If
    Application.EnableEvents = True
 End If
End Sub

JB
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Liste selection multiple VBA

De plus, pour séparer les différents noms peut on faire un passage à la ligne d'en dessous en restant dans la même cellule?
J'ai cru voir sur internet que ca se traduisait par Chr(10) est-ce ca ?
 
Vote positif 0 Vote négatif
Re : Liste selection multiple VBA

Oui pardon. J'ai consulté pas mal de site alors je me perds 🙂
Comment faire pour mettre en place le système de décochage / suppression du nom s'il est déjà sélectionné ?

Cordialement,
 
Vote positif 0 Vote négatif
Re : Liste selection multiple VBA

Re,

Pour répondre à votre post #15 :

Maud44 à dit:
Par contre, dans le cas du dernier message lorsqu'on clique sur un agent deux fois...le nom se met deux fois dans la cellule. Cependant je voudrais qu'il disparaisse. Une sorte de "cochage" et "décochage".
Cliquez pour agrandir...

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Range("E2:E" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.EnableEvents = False 'désactive les événements
For Each r In r 'si plusieurs cellules sont modifiées
  With Cells(r.Row, "G")
    If CStr(r) = "" Then
      .Value = ""
    Else
      If InStr(.Text, CStr(r)) Then
        .Value = Replace(.Text, CStr(r) & vbLf, "")
        .Value = Replace(.Text, vbLf & CStr(r), "")
        .Value = Replace(.Text, CStr(r), "")
      Else
        .Value = .Text & IIf(.Text = "", "", vbLf) & CStr(r)
      End If
      r = .Value
    End If
    r.EntireRow.AutoFit 'ajustement de la hauteur
  End With
Next
Application.EnableEvents = True 'réactive les événements
End Sub
Fichier (4).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Liste selection multiple VBA

Re Jacques,

J'avais bien pensé à Application.Undo.

L'ennui c'est qu'il semble difficile de l'appliquer si plusieurs cellules sont modifiées ou effacées simultanément.

Avec la colonne auxiliaire pas de problème.

Bonne nuit.
 
Vote positif 0 Vote négatif
Re : Liste selection multiple VBA

Bonjour Maud44, JB, le forum,

Bon, même en modifiant plusieurs cellules on peut utiliser Application.Undo :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, c As Range, mem$(), i&
Set r = Intersect(Target, Range("E2:E" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les événements
ReDim mem(1 To r.Count)
Application.Undo 'annule l'entrée
For Each c In r 'si plusieurs cellules sont modifiées
  i = i + 1
  mem(i) = CStr(c) 'mémorisation
Next
Application.Undo 'restitue l'entrée
i = 0
For Each c In r
  i = i + 1
  If CStr(c) <> "" Then
    If InStr(mem(i), CStr(c)) Then
      mem(i) = Replace(mem(i), CStr(c) & vbLf, "")
      mem(i) = Replace(mem(i), vbLf & CStr(c), "")
      mem(i) = Replace(mem(i), CStr(c), "")
    Else
      mem(i) = mem(i) & IIf(mem(i) = "", "", vbLf) & CStr(c)
    End If
    c = mem(i)
  End If
Next
Application.EnableEvents = True 'réactive les événements
End Sub
Donc plus besoin de colonne auxiliaire.

Nota : finalement l'ajustement de la hauteur des lignes ne paraît pas nécessaire.

Fichier (5).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Liste selection multiple VBA

Re,

On aura peut-être remarqué quelques problèmes sur le fichier (5) si l'on supprime ou insère des lignes en colonne E.

Ce fichier (6) les évite :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, dercel As Range, derlig&, c As Range, mem$(), i&
Set r = Intersect(Target, Range("E2:E" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les événements
On Error Resume Next
Set dercel = Cells(Me.UsedRange.Row + Me.UsedRange.Rows.Count, "E")
ReDim mem(1 To r.Count)
Application.Undo 'annule l'entrée
derlig = dercel.Row
For Each c In r 'si plusieurs cellules sont modifiées
  i = i + 1
  mem(i) = CStr(c) 'mémorisation
Next
Application.Undo 'restitue l'entrée
If derlig = dercel.Row Then 'pas d'insertion/suppression de ligne
  i = 0
  For Each c In r
    i = i + 1
    If CStr(c) <> "" Then
      If InStr(mem(i), CStr(c)) Then
        mem(i) = Replace(mem(i), CStr(c) & vbLf, "")
        mem(i) = Replace(mem(i), vbLf & CStr(c), "")
        mem(i) = Replace(mem(i), CStr(c), "")
      Else
        mem(i) = mem(i) & IIf(mem(i) = "", "", vbLf) & CStr(c)
      End If
      c = mem(i)
    End If
  Next
End If
Application.EnableEvents = True 'réactive les événements
End Sub
A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Liste selection multiple VBA

Bonsoir,
Je reviens à l'attaque pour une question toute simple. Je voudrais appliquer le même code que dans le cellule E2 a la colonne F. Est ce que je peux mettre le code sous le premier code dans la feuille du code ?

Code que je veux mettre :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Range("F2:F" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.EnableEvents = False 'désactive les événements
For Each r In r 'si plusieurs cellules sont modifiées
With Cells(r.Row, "G")
If CStr(r) = "" Then
.Value = ""
Else
If InStr(.Text, CStr(r)) Then
.Value = Replace(.Text, CStr(r) & vbLf, "")
.Value = Replace(.Text, vbLf & CStr(r), "")
.Value = Replace(.Text, CStr(r), "")
Else
.Value = .Text & IIf(.Text = "", "", vbLf) & CStr(r)
End If
r = .Value
End If
r.EntireRow.AutoFit 'ajustement de la hauteur
End With
Next
Application.EnableEvents = True 'réactive les événements
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Liste selection multiple VBA

Bonjour Maud44, le forum,

Je vais faire de la route aujourd'hui donc voici la macro qui traite les 2 colonnes E et F :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, adresse$, c As Range, mem$(), i&
Set r = Intersect(Target, [E:F], Rows("2:" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les événements
On Error Resume Next
ReDim mem(1 To r.Count)
Application.Undo 'annule l'entrée
adresse = r.Address
For Each c In r 'si plusieurs cellules sont modifiées
  i = i + 1
  mem(i) = CStr(c) 'mémorisation
Next
Application.Undo 'restitue l'entrée
If adresse <> r.Address Then GoTo 1 'si insertion/suppression de ligne
i = 0
For Each c In r
  i = i + 1
  If CStr(c) <> "" Then
    If InStr(mem(i), CStr(c)) Then
      mem(i) = Replace(mem(i), CStr(c) & vbLf, "")
      mem(i) = Replace(mem(i), vbLf & CStr(c), "")
      mem(i) = Replace(mem(i), CStr(c), "")
    Else
      mem(i) = mem(i) & IIf(mem(i) = "", "", vbLf) & CStr(c)
    End If
    c = mem(i)
  End If
Next
1 Application.EnableEvents = True 'réactive les événements
End Sub
C'est une adaptation de la macro du post #24.

Edit : j'ai revu le test pour l'insertion ou suppression de ligne.

Nota 1 : il ne fallait pas oublier de supprimer la colonne masquée G.

Nota 2 : curieuse idée de mettre des / dans la liste des agents !!

Fichier joint.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Liste selection multiple VBA

salut

pour accompagner job 😉 un bout de chemin avant de bifurquer ...

Nota : j'ai pris l'évènement Clic/Droit car je n'arrive pas à gérer la rapidité des "clic / doubleclic" de mes souris malgré de nombreuses recherches et manipulations. Si... l'un d'entre vous a résolu ce problème, je le remercie par avance de la communication de la méthode.
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Liste selection multiple VBA

Re, salut Si...

Comme vous dites, faudrait peut-être "attaquer" Maud44 🙄

Les macros des posts #23 #24 #27 ont été testées sur Excel 2010.

Mais elles ne fonctionnent pas correctement sur Excel 2003.

Cette version (2) fonctionne sur toute version :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim derlig&, r As Range, adresse$, c As Range, mem$(), i&
derlig = [E:F].Find("*", , xlValues, , xlByRows, xlPrevious).Row
Set r = Intersect(Target, Range("E2:F" & derlig))
If derlig < 2 Or r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les événements
On Error Resume Next
ReDim mem(1 To r.Count)
Application.Undo 'annule l'entrée
adresse = r.Address
For Each c In r 'si plusieurs cellules sont modifiées
  i = i + 1
  mem(i) = CStr(c) 'mémorisation
Next
Application.Undo 'restitue l'entrée
If adresse <> r.Address Then GoTo 1 'si insertion/suppression de ligne
i = 0
For Each c In r
  i = i + 1
  If CStr(c) <> "" Then
    If InStr(mem(i), CStr(c)) Then
      mem(i) = Replace(mem(i), CStr(c) & vbLf, "")
      mem(i) = Replace(mem(i), vbLf & CStr(c), "")
      mem(i) = Replace(mem(i), CStr(c), "")
    Else
      mem(i) = mem(i) & IIf(mem(i) = "", "", vbLf) & CStr(c)
    End If
    c = mem(i)
  End If
Next
1 Application.EnableEvents = True 'réactive les événements
Application.ScreenUpdating = True
End Sub
Edit : ajouté à la fin Application.ScreenUpdating = True, c'est nécessaire si l'on fait du copier/coller.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

L
  • Résolu(e)
Microsoft 365 RechercheV avec une condition poids
2
Réponses
16
Affichages
429
Lina
L
D
  • Résolu(e)
Microsoft 365 carte choroplèthe et conditionner la couleur selon une liste déroulante de choix
Réponses
8
Affichages
788
Daniel200666
D
Zdz16
  • Résolu(e)
XL 2021 Liste de validation de données à partir d'une table
Réponses
3
Affichages
502
Zdz16
Zdz16
P
  • Résolu(e)
XL 2021 Formule avec SI ET et si possible plusieurs ET
Réponses
4
Affichages
306
PR.
P
U
  • Résolu(e)
Autres Comment modifier les macros pour qu’elles arrivent à faire ce que je veux
Réponses
6
Affichages
278
un internaute
U
E
  • Question Question
Microsoft 365 Création d'un filtre sur une cellule avec recherche de mot indexé
Réponses
3
Affichages
349
elgringo123456
E
C
  • Question Question
Microsoft 365 Liste déroulante dynamique / dépendante d'un critère ou plus, *sans* VBA ? Une sorte d'Unique à conditions ? + ordre alpha ?
Réponses
8
Affichages
415
JHA
J
D
  • Question Question
XL 2016 Une Zone de Liste pour plusieurs cellules.
Réponses
7
Affichages
439
duduche62
D
M
  • Résolu(e)
XL 2016 Comment contourner la fonction Indirect d'Excel avec code VBA
Réponses
11
Affichages
674
ma6me
M
F
  • Question Question
XL 2016 Transformation fichier
Réponses
6
Affichages
328
Cousinhub
Cousinhub
R
  • Résolu(e)
Microsoft 365 Tableau convocations
2
Réponses
29
Affichages
2 K
Rosario.
R
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
430
patricktoulon
patricktoulon
O
  • Résolu(e)
XL 2013 Formule ou une programmation VBA qui permette de répartir des numéros de factures par ligne
Réponses
3
Affichages
308
JHA
J
D
  • Question Question
Microsoft 365 Problème Option de Collage
Réponses
10
Affichages
1 K
duduche62
D
Y
  • Question Question
XL 2021 Liste déroulante filtrée par les 2 premiers caractères
2
Réponses
28
Affichages
936
Dudu2
Dudu2
D
  • Question Question
XL 2021 Liste déroulante et RECHERCHEV
Réponses
5
Affichages
630
Dubuyz1
D
T
  • Question Question
XL 2021 Formule indirect + liste déroulante
Réponses
1
Affichages
552
JHA
J
T
  • Question Question
XL 2013 Colonne dynamique en fonction de choix d'une liste déroulante
Réponses
5
Affichages
848
JHA
J
S
  • Résolu(e)
Microsoft 365 Conserver lien hypertexte avec une fonction RechercheV
2
Réponses
19
Affichages
2 K
job75
job75
C
  • Résolu(e)
XL 2016 Propriété pour déterminer si la sélection correspond à une plage de cellules
Réponses
2
Affichages
268
crocrocro
C
Retour