Liste déroulante et macro

Question

Je me permets d'écrire une question sur le forum car j'aurais besoin d'aide pour mettre en place une liste déroulante type formulaire ou active X) sur excel. Je vous explique mon problème: j'ai un onglet "données" dans lequel j'ai des informations saisies manuellement (client, mois, code article, ventes...) et je souhaiterais que sur un autre onglet "visuel" je puisse récupérer des données de mon onglet base de données à l'aide d'une liste déroulante basée sur mes clients. Je souhaiterais par exemple, sélectionner dans ma liste déroulante le client A et voir apparaitre les ventes, articles, mois de ce client de façon automatique. J'ai joint un fichier excel au cas où mon explication n'est pas clair. Je vous remercie d'avancer pour votre aide et sympathie, Cordialement...

James007 · Answer

A ta place ... je plonge direct sur un TCD ... en 2 secondes tout est fait ... Ci-joint ton fichier .....

MFerrand · Answer

Réaménagement de Visuel : liste déroulante Client en A2. Private Sub Worksheet_Change(ByVal Target As Range) Dim cli$, a% If Target.Address = "$A$2" Then If Target &lt;&gt; "" Then cli = Target: a = Target.Cells(1, 2) Recherche cli, a Else a = Me.Range("B3").CurrentRegion.Rows.Count - 3 Me.Range("B4").Resize(a, 10).ClearContents End If End If End Sub Procédure dans le module de la feuille Visuel. Se déclenche lors d'un changement en A2. Si un client sélectionné, lance la proc. Recherche. Sub Recherche(cli As String, a As Integer) Dim dA1(), dA2(), v1%, v2%, n%, i%, j%, col col = Array(3, 4, 5, 14, 22) With Worksheets("données") n = .Cells(.Rows.Count, 1).End(xlUp).Row For i = 2 To n If .Cells(i, 2) = cli Then If .Cells(i, 1) = a Then ReDim Preserve dA1(4, v1) For j = 0 To 4 dA1(j, v1) = .Cells(i, col(j)) Next j v1 = v1 + 1 ElseIf .Cells(i, 1) = a + 1 Then ReDim Preserve dA2(4, v2) For j = 0 To 4 dA2(j, v2) = .Cells(i, col(j)) Next j v2 = v2 + 1 End If End If Next i End With Application.ScreenUpdating = False With Worksheets("Visuel") n = .Range("B3").CurrentRegion.Rows.Count - 3 .Range("B4").Resize(n, 10).ClearContents If v1 &gt; 0 Then .Range("B4").Resize(v1, 5).Value = WorksheetFunction.Transpose(dA1) If v2 &gt; 0 Then .Range("G4").Resize(v2, 5).Value = WorksheetFunction.Transpose(dA2) End With End Sub NB- Dans la mesure où l'on poursuivra d'année en année (2017 et 2018 remplaçant 2016 et 2017, etc.) il conviendrait d'asservir la 2e année à la 1re avec une formule : =B2+1 Eventuellement mettre la première année sous liste déroulante... et si l'on pouvoir faire des retours dans le temps inclure le changement en B2 pour déclencher la procédure (tenir compte qu'il s'agit d'une cellule fusionnée). Cordialement...

MFerrand · Answer

La proc. Change utilise la variable a (qui alors ne sert pas à recueillir l'année).

Mais la proc. Recherche utilise n pour cette action, n étant initialisée pour cela juste à la ligne précédente.

Omission de ma part ! Je n'ai pas tenu compte du cas où la zone est vide, ce qui déclenche l'erreur (je n'avais introduit l'effacement en cas de non sélection qu'à la fin...)

Modifie la ligne comme suit :

If n > 0 Then .Range("B4").Resize(n, 10).ClearContents

Cordialement.

MFerrand · Answer

Tu rajustes tous les autres éléments de la macro ! Tout est à redimensionner ...

MFerrand · Answer

Reprenons les procédures... Une colonne de plus en Visuel pour chaque année : le tableau ira de B à M (au lieu de K), 12 colonnes au lieu de 10... Private Sub Worksheet_Change(ByVal Target As Range) Dim cli$, a% If Target.Address = "$A$2" Then If Target &lt;&gt; "" Then cli = Target: a = Target.Cells(1, 2) Recherche cli, a Else a = Me.Range("B3").CurrentRegion.Rows.Count - 3 Me.Range("B4").Resize(a, 12).ClearContents End If End If End Sub Sur la proc. Change, elle lance Recherche (donc c'est dans Recherche que ça va se passer) si un client est à chercher. Sinon elle efface, le dimensionnement de la zone effacée passe de 10 à 12 colonnes : la seule modification à opérer est donc le 10 (colonnes) par 12 dans le dimensionnement de la plage... Sub Recherche(cli As String, a As Integer) Dim dA1(), dA2(), v1%, v2%, n%, i%, j%, col col = Array(3, 4, 5, 14, 16, 22) With Worksheets("données") n = .Cells(.Rows.Count, 1).End(xlUp).Row For i = 2 To n If .Cells(i, 2) = cli Then If .Cells(i, 1) = a Then ReDim Preserve dA1(5, v1) For j = 0 To 5 dA1(j, v1) = .Cells(i, col(j)) Next j v1 = v1 + 1 ElseIf .Cells(i, 1) = a + 1 Then ReDim Preserve dA2(5, v2) For j = 0 To 5 dA2(j, v2) = .Cells(i, col(j)) Next j v2 = v2 + 1 End If End If Next i End With Application.ScreenUpdating = False With Worksheets("Visuel") n = .Range("B3").CurrentRegion.Rows.Count - 3 If n &gt; 0 Then .Range("B4").Resize(n, 12).ClearContents If v1 &gt; 0 Then .Range("B4").Resize(v1, 6).Value = WorksheetFunction.Transpose(dA1) If v2 &gt; 0 Then .Range("G4").Resize(v2, 6).Value = WorksheetFunction.Transpose(dA2) End With End Sub Colonne ajoutée : on l'intègre comme tu l'as fait dans le tableau des numéros de colonnes, qui passe de 5 à 6 valeurs (indices 0 à 5). Les tableaux dA1 et dA2 recueillant les résultats pour chacune des années doivent être dimensionnés en conséquence : leur première dimension (correspondant aux colonnes) passe donc de 4 à 5. Et la boucle j de 0 à 4 pour servir ces tableaux passe également de 0 à 5. Redimensionnement de 10 à 12 pour l'effacement (comme précédemment pour Change). Et redimensionnement de 5 à 6 colonnes pour chacune des années, lors de l'affectation. C'est tout ce qui a bougé semble-t-il ! NB- Désolé pour la fausse manoeuvre qui a lâché le post incomplet... Cordialement...

MFerrand · Answer

G —› H ! J'avais zappé ce décalage ! je dois commencer à fatiguer !

On peut trier les tableaux... Mais demain (après que j'aurais fait rétablir l'eau ! C'est pas l'eau qui manque mais je ne peux l'ouvrir sans inonder la voisine, je venais où je suis pour ranger après travaux, fini sauf un petit truc... )

A+