Formulaire de recherche à critères multiples (Userform)
Bonjour à tous,
J'essaye de développer un petit formulaire de recherche à critères multiple sous la forme d'un userform. Mon expérience s'arrête jusqu'à présent à quelques formulaire de saisies assez basiques ( j'apprend à mon rythme
Aujourd'hui je suis complètement bloqué sur un formulaire de recherche, dont la fonction primaire est assez simple et qui se décrit comme suit :
Je cherche à afficher dans en fonction des données présentes en colonne D ( combo box 1) et colonne E ( combo box 2 ) l'ensemble des lignes de mon tableau comprenant les données présent en CB1 et CB2. Je souhaite afficher l'ensemble des lignes dans une List box. Enfin je souhaiterais également dans ma ( Text box 1 ) afficher la somme présente en colonne H selon les critères en CB1 et CB2.
Petite spécification ( que je n'arrive pas à mettre à l'œuvre ) dans ma CB1 et CB2 je souhaite afficher les références sous la forme d'une liste purger des doublons
Il va s'en dire que n'arrive pas à mettre à l'œuvre ce que j'ai en tête sous la forme de mon code VBA, j'obtient en permanence une erreur " erreur d'exécution 438".
Voici mon code extrêmement archaïque
' Déclarez la fonction isValueInCollection ici
Private Function IsInCollection(coll As Collection, value As String) As Boolean
IsInCollection = coll.Exists(value)
End Function
Private Sub UserForm_Initialize()
Dim valuesColD As Collection
Dim valuesColE As Collection
Dim i As Long
valueColD = Me.ComboBox1.value
valueColE = Me.ComboBox2.value
Set valuesColD = New Collection
Set valuesColE = New Collection
'Remplir la combo box 1 avec les valeurs uniques de la colonne D
For i = 1 To Worksheets("Feuil1").Range("D" & Rows.Count).End(xlUp).Row
If Not IsInCollection(valuesColD, CStr(Worksheets("Feuil1").Cells(i, 4).value)) Then
valuesColD.Add CStr(Worksheets("Feuil1").Cells(i, 4).value), CStr(Worksheets("Feuil1").Cells(i, 4).value)
End If
Next i
Me.ComboBox1.List = valuesColD.ToArray()
'Remplir la combo box 2 avec les valeurs uniques de la colonne E
For i = 1 To Worksheets("Feuil1").Range("E" & Rows.Count).End(xlUp).Row
If Not IsInCollection(valuesColE, CStr(Worksheets("Feuil1").Cells(i, 5).value)) Then
valuesColE.Add CStr(Worksheets("Feuil1").Cells(i, 5).value), CStr(Worksheets("Feuil1").Cells(i, 5).value)
End If
Next i
Me.ComboBox2.List = valuesColE.ToArray()
End Sub
Private Sub CommandButton1_Click()
Dim valueColD As String
Dim valueColE As String
Dim i As Long
Dim found As Boolean
valueColD = Me.ComboBox1.value
valueColE = Me.ComboBox2.value
Me.ListBox1.Clear
Me.TextBox1.value = 0
' Rechercher les lignes qui correspondent aux critères de la combo box 1 et 2
For i = 1 To Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
found = (Worksheets("Feuil1").Cells(i, 4).value = valueColD) And (Worksheets("Feuil1").Cells(i, 5).value = valueColE)
If found Then
' Ajouter la ligne à la liste box
Me.ListBox1.AddItem Worksheets("Feuil1").Range("A" & i).value & " | " & _
Worksheets("Feuil1").Range("B" & i).value & " | " & _
Worksheets("Feuil1").Range("C" & i).value & " | " & _
Worksheets("Feuil1").Range("D" & i).value & " | " & _
Worksheets("Feuil1").Range("E" & i).value & " | " & _
Worksheets("Feuil1").Range("F" & i).value & " | " & _
Worksheets("Feuil1").Range("G" & i).value & " | " & _
Worksheets("Feuil1").Range("H" & i).value
' Ajouter la valeur de la colonne H à la textbox1
Me.TextBox1.value = Me.TextBox1.value + Worksheets("Feuil1").Cells(i, 8).value
End If
Next i
End Sub
Private Sub CommandButton2_Click()
Me.Hide
End SubEdit modo : merci de mettre le code entre balises SVP avec le bouton </>
Je vous joins également mon fichier Excel, avec le code, le brouillon de mon userform, ainsi que le tableau source.
Vous remerciant de votre aide par avance.
Bonjour Toxxid et
Une petite présentation ICI serait la bienvenue
Je vous invite à lire :
- La charte du forum
- Quelques fonctionnalités du forum à connaître
qui vous aideront dans vos demandes et réponses sur ce forum et notamment :
- Pour plus de lisibilité, utilisez la fonctionnalité </> pour insérer vos codes VBA (et si possible aussi pour vos formules Excel) et les mettre entre balises.
Regardez aussi les petites icônes mises à votre disposition dans la barre de menu qui :
- vous permettent de poster un code (</>)
- ou de clôturer un fil lorsque vous avez terminé (V)
Merci pour votre participation
Cordialement
Bonjour,
Le souci vient de cette ligne:
IsInCollection = coll.Exists(value)qui vient de la fonction:
Private Function IsInCollection(coll As Collection, value As String) As Booleanqui est appelée lors de l'initialisation du formulaire.
Une Collection n'a pas de méthode Exists contrairement à son cousin le Dictionary présent dans la bibliothèque "Microsoft Scripting Runtime".
Un moyen de contourner le problème en continuant à utiliser une collection:
test = Empty
On Error Resume Next
test = coll(value)
On Error GoTo 0
IsInCollection = Not test = EmptyIl y a visiblement un problème ici aussi:
Me.ComboBox1.List = valuesColD.ToArray()ToArray n'est pas une méthode gérée ici non plus.
Il y a le même souci ici:
Me.ComboBox2.List = valuesColE.ToArray()J'imagine que ce que vous souhaitez faire est:
Me.ComboBox1.List = Array(valuesColD)
Me.ComboBox2.List = Array(valuesCol)Ça fait déjà pas mal de soucis avant même de faire la recherche donc je m'arrête à ça pour cette première réponse.
Bonjour Ausecour,
Pour le code sur la CB1 et la CB2 c'est en effet ce que je voulais réaliser :
Me.ComboBox1.List = Array(valuesColD)
Me.ComboBox2.List = Array(valuesCol)En revanche pour la ligne :
Private Function IsInCollection(coll As Collection, value As String) As Boolean
IsInCollection = coll.Exists(value)C'est la ou je patauge, avec cette fonction je souhaite définir deux arguments : La collection dans laquelle on vient chercher la valeur " coll" et " value" la valeur qu'on vient chercher dans la collection. La fonction promulgue un résultat "boolean" vrai ou faux si la valeur est dans la collection.
Avec cette fonction je souhaite donc définir la collection de valeur ( sans doublon ) qui sera appeler en CB1 et CB2 :
Si on prend mon tableau Excel en CB1 je veux toutes les valeurs de la colonne D sans doublon / CB2 toutes les valeurs en colonne E sans les doublons
Lorsque j'essaye d'utiliser votre code :
test = Empty
On Error Resume Next
test = coll(value)
On Error GoTo 0
IsInCollection = Not test = Emptyj'obtiens une erreur de compilation
Je suis preneur si tu as des compléments sur ton code, et pourquoi celui-ci ne fonctionne possiblement pas
Bien à toi,
Thomas
Bonjour,
Je pense que je n'avais pas tout compris lors de mon premier retour, pour ce qui est de l'initialisation du formulaire, je suis plutôt parti sur ça:
Private Sub UserForm_Initialize()
Dim ligFin As Long
With Worksheets("Feuil1")
ligFin = Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
'Remplir la combo box 1 avec les valeurs uniques de la colonne D
Me.ComboBox1.List = tableauSansDoublon(.Range("D2", "D" & ligFin).value)
'Remplir la combo box 2 avec les valeurs uniques de la colonne E
Me.ComboBox2.List = tableauSansDoublon(.Range("E2", "E" & ligFin).value)
End With
End Subqui utilise cette fonction:
Function tableauSansDoublon(tableau) As Variant
Dim Valeurs As New Collection
Dim resultat As Variant
On Error Resume Next
For i = LBound(tableau, 1) To UBound(tableau, 1)
Valeurs.Add tableau(i, 1), CStr(tableau(i, 1))
Next i
On Error GoTo 0
ReDim resultat(1 To Valeurs.Count, 1 To 1)
For i = 1 To Valeurs.Count
resultat(i, 1) = Valeurs(i)
Next i
tableauSansDoublon = resultat
End FunctionJ'alimente directement les listes des Combobox avec un tableau retourné par la fonction "tableauSansDoublon", cette fonction ne prends qu'un paramètre, le tableau qui doit être traité. Elle ne traite que les tableaux avec une colonne correctement, ce qui est le cas ici, je lui donne les valeurs en colonne D, puis celles en colonne E.
Elle utilise l'object Collection, pour chaque lignes de la colonne, j'essaye d'ajouter la valeur à la collection en utilisant cette même valeur comme clé, la particularité d'une Collection c'est qu'une clé est unique, donc si on essaye d'ajouter une valeur avec une clé déjà présente, ça renvoie normalement une erreur. Comme j'ai utilisé "On Error Resume Next", le code va juste continuer en ignorant l'erreur, j'ai mis "On Error GoTo 0" pour qu'ensuite les paramètres de gestion d'erreur soient de nouveau par défaut.
Grâce à ça je peux faire un tableau avec uniquement les valeurs présentes dans la collection, qui me permet également de dimensionner le tableau final.
Voilà ce que ça donne pour le moment, l'initialisation me semble bien fonctionner:
Bonjour Ausecour,
Pardonne mon délais de réponse, je n'étais pas disponible les derniers jours
Le résultat obtenu et celui que je souhaitais, et je n'avais une seule seconde imaginais procéder de la sorte.
Concernant le code, j'ai effectué quelques modifications, mais je reste bloqué sur certains points...
tout d'abord :
j'ai modifié cette partie du code afin de pouvoir afficher dans la liste box uniquement le critère de recherche sélectionné dans la CB1 ou CB2. j'ai tout simplement rajouté un Or à la place du And
' Rechercher les lignes qui correspondent aux critères de la combo box 1 et 2
For i = 1 To Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
found = (Worksheets("Feuil1").Cells(i, 4).value = valueColD) Or (Worksheets("Feuil1").Cells(i, 5).value = valueColE)
If found Thenj'ai modifié le également le commandbouton 2 pour qu'il nettoie le userform sans le fermer :
Private Sub CommandButton2_Click()
Me.ListBox1.Clear
Me.ComboBox1.value = ""
Me.ComboBox2.value = ""
Me.TextBox1.value = 0
End SubEn revanche pour les sujets pour lesquels je bloque sont les suivants :
J'essaye d'afficher les en-têtes de mon tableau dans ma listbox, néanmoins avec le code que j'applique, il semblerait que les en-têtes se génèrent mal... et je n'arrive pas à déceler l'erreur... :
' Rechercher les lignes qui correspondent aux critères de la combo box 1 et 2
For i = 1 To Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
found = (Worksheets("Feuil1").Cells(i, 4).value = valueColD) Or (Worksheets("Feuil1").Cells(i, 5).value = valueColE)
If found Then
' Ajouter la ligne à la liste box
Me.ListBox1.AddItem Worksheets("Feuil1").Range("A" & i).value & " | " & _
Worksheets("Feuil1").Range("B" & i).value & " | " & _
Worksheets("Feuil1").Range("C" & i).value & " | " & _
Worksheets("Feuil1").Range("D" & i).value & " | " & _
Worksheets("Feuil1").Range("E" & i).value & " | " & _
Worksheets("Feuil1").Range("F" & i).value & " | " & _
Worksheets("Feuil1").Range("G" & i).value & " | " & _
Worksheets("Feuil1").Range("H" & i).value
End If
Next i
' Ajouter les entêtes de colonne à la liste box
Me.ListBox1.AddItem Worksheets("Feuil1").Range("A1").value & " | " & _
Worksheets("Feuil1").Range("B1").value & " | " & _
Worksheets("Feuil1").Range("C1").value & " | " & _
Worksheets("Feuil1").Range("D1").value & " | " & _
Worksheets("Feuil1").Range("E1").value & " | " & _
Worksheets("Feuil1").Range("F1").value & " | " & _
Worksheets("Feuil1").Range("G1").value & " | " & _
Worksheets("Feuil1").Range("H1").valueEnsuite je me suis aperçu que les résultats dans la listbox se cumulent lorsque je change de critères de recherche dans ma CB1 ou CB2, je m'explique :
Je souhaite chercher tous les abricots ( CB1) présent dans mon tableau peut importe les critères de destination ( CB2 ), la listbox génère les résultats.
Je souhaite ensuite affiner ma recherche, en en rajoutant en CB2 une condition de destination ( FRANCE ). La liste box ne supprime pas les résultats précédents et cumule les lignes.
je souhaites que dès lors que je modifie un critères dans ma CB1 ou CB2, la listbox s'actualise sans cumuler les résultats.
je n'ai pas trop d'idée pour conditionner le résultat...
je te joints ma version avec mes modifications,
Merci pour ton aide !
Bonjour,
Voici une proposition:
J'ai complètement supprimé le commandbutton1 ainsi que son code, à la place je mets à jour la liste à chaque fois qu'il y a un changement dans l'une des listes déroulantes.
J'ai créé une dépendance entre la liste de désignation et celle pour la destination, la liste de destination ne sera chargée que si tu as une valeur dans la désignation.
Pour le reste tu verras dans le fichier.
Bonjour,
Le résultat est parfait, c'est exactement ce que je souhaitais faire, sans arriver à mettre une ligne de code en face de mon idée.
Pour le reste c'est tout bon je vais effectuer quelque ajustement à mon userform !
j'ai juste une dernière difficulté, j'essaye que l'ensemble des cellules généré dans ma liste box soient parfaitement dimensionné, et que donc tous les caractères soient visibles :
j'ai essayé ce code, mais ça ,ne semble pas bouger, j'ai oublié quelque chose ?
Sub majListe()
Dim ligFin As Long
With Sheets("Filtre")
ligFin = .Range("A" & Rows.Count).End(xlUp).Row
ListBox1.RowSource = "Filtre!" & .Range("A5:H" & ligFin).Address
'Redimensionner les cellules
.Range("A5:H" & ligFin).Columns.AutoFit
End With
End Submerci encore
Bonjour,
En effet, il faut agir sur :
ListBox1.ColumnWidthsCar c'est la propriété qui permet de définir les différentes largeurs de colonne.
Eventuellement on peut partir sur quelque chose comme ça:
Function getColumnWidths(Plage As Range) As String
Dim texte As String
For col = 1 To Plage.Columns.Count
If Not texte = "" Then
texte = texte & ";"
End If
texte = texte & Plage.Cells(1, col).ColumnWidth * 5
Next col
getColumnWidths = texte
End Functionet
ListBox1.ColumnWidths = getColumnWidths(.Range("A5:H5" ))Bon j'ai fait de l'à peu près car je ne sais pas vraiment comment convertir la largeur pour une ListBox.