XL 2016 VBA Liste déroulante

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 !

mapomme à dit:

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

Cliquez pour agrandir...