XL 2016 VBA Liste déroulante

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 !

Myaah

XLDnaute Nouveau
Bonjour,

Je vous contacte pour une petite question qui fait suite à la première discussion que j'avais créée. Je cherchais un moyen de pouvoir récupérer dans un tableau (sur la même feuille) les choix sélectionnés dans une liste déroulante afin de pouvoir les comptabiliser. On m'a bien aidé et envoyé un code qui marche parfaitement ! (et qui, en plus, concatène dans une autre cellule les 3 choix les plus sélectionnés).
J'aimerais pouvoir utiliser ce code plusieurs fois sur une même feuille, avec deux listes différentes (liste de fruits et liste de légumes par exemple). Quelqu'un saurait peut-être me dire si cela est possible et si je peux adapter le code dans ce sens ? J'ai fais plusieurs tentatives sans résultats..

Merci et bonne journée ! 🙂
Re,

Merci pour les éclaircissements. Voici une tentative.
J'ai choisi une liste de validation en A1 dont la source est en colonne K. Pour les trois premiers, on trie par nombre de sélection puis par ordre alphabétique des choix et on prend les trois premiers. Il peut rester des ex-æquo non affichés (puisqu'on ne prend que les trois premiers).
Le code est dans le module de la feuille "Feuil1" :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, r, i As Long, ech As Boolean, aux, s$
   If Intersect(Target, Range("a1")) Is Nothing Then Exit Sub
   Application.ScreenUpdating = False
   t = Range("d1:e10").Value
   For i = 2 To UBound(t)
      If t(i, 1) = Target Then t(i, 2) = t(i, 2) + 1: Exit For
   Next i
   Range("d1:e10") = t
   Range("d1:e10").Sort key1:=Range("e1"), order1:=xlDescending, key2:=Range("d1"), order2:=xlAscending, _
                  MatchCase:=xlNo, Header:=xlYes
   r = Range("d1:e10").Value: Range("d1:e10") = t
   For i = 2 To 4
      If r(i, 2) <> "" And r(i, 2) <> "" Then s = s & " / " & r(i, 1)
   Next i
   Range("b1").ClearContents
   If s <> "" Then Range("b1") = Mid(s, 3)
End Sub
 
- 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

Discussions similaires

Réponses
8
Affichages
116
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
248
  • Question Question
Microsoft 365 Probléme VBA
Réponses
8
Affichages
231
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
499
Retour