Rechercher Par listbox suivant deux criteres

maval

XLDnaute Barbatruc
Bonsoir,

J'ai un formulaire avec une recherche par listbox, j'aimerai remplir mes textbox suivant deux critères par le genre qui se trouve dans la feuille nommer "Genre" par le nom du film qui se trouve dans la feuille "données"

Je vous remercie d'avance
 

Pièces jointes

  • LISTBOX.xlsm
    182.2 KB · Affichages: 75
  • LISTBOX.xlsm
    182.2 KB · Affichages: 76
  • LISTBOX.xlsm
    182.2 KB · Affichages: 79

Regueiro

XLDnaute Impliqué
Re : Rechercher Par listbox suivant deux criteres

Bonsoir le Forum, Maval
Voici un début de code à compléter éventuellement par une boucle for i pour remplir plus rapidement
les Textbox

Code:
Private Sub ListBox1_Change()
Dim ligne
Dim MaBD As Worksheet
Set MaBD = Sheets("Données")
ligne = MaBD.Range("A3").Offset(ListBox1.ListIndex, 0).Row
Me.TextBox1 = MaBD.Cells(ligne, 1)
Me.TextBox2 = MaBD.Cells(ligne, 2)
Me.TextBox3 = MaBD.Cells(ligne, 3)
End Sub
A+
 

Regueiro

XLDnaute Impliqué
Re : Rechercher Par listbox suivant deux criteres

Re
Voici le code avec une boucle pour remplir les 12 Textbox

Code:
Private Sub ListBox1_Change()
Dim ligne
Dim i
Dim MaBD As Worksheet
Set MaBD = Sheets("Données")
ligne = MaBD.Range("A3").Offset(ListBox1.ListIndex, 0).Row
For i = 1 To 12
Me("Textbox" & i) = MaBD.Cells(ligne, i)
Next i
End Sub
 

Regueiro

XLDnaute Impliqué
Re : Rechercher Par listbox suivant deux criteres

Bonsoir Le Forum
Voici le code correct :

Code:
Private Sub ListBox1_Change()
Dim ligne As Integer
Dim Trouve As Range
Dim i%
Dim Nom As String
Dim MaBD As Worksheet
Set MaBD = Sheets("Données")
If Me.ListBox1.ListIndex > -1 Then
Nom = Me.ListBox1.List(Me.ListBox1.ListIndex)
End If
Set Trouve = MaBD.Columns("A").Find(Nom, lookat:=xlWhole)
If Trouve Is Nothing Then
MsgBox Nom & " pas trouvé dans la liste sur la feuille " & MaBD.Name
Else
ligne = Trouve.Row
MsgBox "Ligne " & ligne
    For i = 1 To 12
        Me("Textbox" & i) = MaBD.Cells(ligne, i)
    Next i
End If
Set Trouve = Nothing
End Sub
 

maval

XLDnaute Barbatruc
Re : Rechercher Par listbox suivant deux criteres

Bonjour Regueiro

Je te remercie exactement la recherche, juste une petite modif, j'ai changer la

"MsgBox "Ligne " & ligne"
par
"Label35 "Ligne " & ligne"

sa ne fonctionne pas pourquoi?

Je te remercie et te souhaite une bonne journée
 

job75

XLDnaute Barbatruc
Re : Rechercher Par listbox suivant deux criteres

Bonjour maval, Regueiro,

La ligne 2 de la feuille "Données" étant vide, on peut s'en servir pour effacer les TextBoxes si le film n'existe pas :

Code:
Private Sub ListBox1_Change()
Dim i As Variant, j As Byte
With Sheets("Données")
  i = Application.Match(ListBox1, .[A:A], 0)
  If IsError(i) Then i = 2 '2 => ligne vide
  For j = 1 To 12
    Me("TextBox" & j) = .Cells(i, j)
  Next
End With
Label35 = IIf(i > 2, "Ligne " & i, "") 'après avoir créé Label35
End Sub
Bonne journée.
 

ChTi160

XLDnaute Barbatruc
Re : Rechercher Par listbox suivant deux criteres

Bonjour maval
Bonjour le Fil
Bonjour le Forum

En Pièce Jointe (.Zip)
Attention une version avec " ListView "
On dezip
On ouvre le Fichier présent puis on Click sur "USER" , On sélectionne le GENRE puis le Film
je n'ai mis que quelques Images (Pochettes)
ainsi qu'une Image si pas de Pochette
voir a Nommer les Pochettes du nom des Films dans la base de Données ex : "1 Guns" ,"2 Guns"
Bons Tests .

Le Fichier : Regarde la pièce jointe CINEMATHEQUE.zip

Bonne fin de Journée
Amicalement
Jean Marie
 
Dernière édition:

Regueiro

XLDnaute Impliqué
Re : Rechercher Par listbox suivant deux criteres

Bonsoir le Forum, Maval
Voici une version de ton fichier avec un Tableau sur la Feuille Données.
il y 2 userform
Userform1 le tien

Userform2 le mien avec un combobox en lieu et place des labels.
Ainsi les items du combobox sont créer dynamiquement si tu rajoutes des genres dans le tableau1
Tu n'as plus besoin de ta feuille Genre

Code:
Option Explicit
Option Base 1
Dim tablo
Public Lstob As ListObject
Private Sub UserForm_Initialize()
Dim AL As Object
Dim F As Worksheet
Dim cel
Dim i As Integer
Me.ListBox2.Visible = False
Set F = Sheets("Données")
Set Lstob = F.ListObjects("Tableau1")
'Met les noms en mémoire dans un tableau
    tablo = Lstob.DataBodyRange.Columns(5).Cells.Value
   'Crée un objet de type ArrayList
   Set AL = CreateObject("System.Collections.ArrayList")
    With AL
      For i = 1 To UBound(tablo, 1)
         If Not .contains(tablo(i, 1)) Then .Add tablo(i, 1) 'ajout au ArrayList
      Next i
      .Sort    'Tri alphabétique
    Me.ComboBox1.List = AL.toarray
    End With

Set AL = Nothing
End Sub
Private Sub CommandButton1_Click()
'on remet le tableau sans filtre en colonne 5
Lstob.Range.AutoFilter Field:=5
Unload Me
End Sub
Private Sub CommandButton2_Click()
ListBox2.Visible = False
Me.ComboBox1.Visible = True
End Sub
Private Sub ListBox2_Change()
Dim ligne As Integer
Dim Trouve As Range
Dim i%
Dim Nom As String
Dim MaBD As Worksheet
Set MaBD = Sheets("Données")
If Me.ListBox2.ListIndex > -1 Then
Nom = Me.ListBox2.List(Me.ListBox2.ListIndex)
End If
Set Trouve = MaBD.Columns("A").Find(Nom, lookat:=xlWhole)
If Trouve Is Nothing Then
MsgBox Nom & " pas trouvé dans la liste sur la feuille " & MaBD.Name
Else
ligne = Trouve.Row
MsgBox "Ligne " & ligne
    For i = 1 To 12
        Me("Textbox" & i) = MaBD.Cells(ligne, i)
    Next i
End If
Set Trouve = Nothing
End Sub
Private Sub ComboBox1_Change()
Dim cel As Range
Me.ListBox2.Clear
For Each cel In Lstob.DataBodyRange.Columns(1).Cells
          If cel.Offset(0, 4) = Me.ComboBox1 Then
      Me.ListBox2.AddItem cel
    End If
  Next cel
  Me.ComboBox1.Visible = False
  Me.ListBox2.Visible = True
End Sub

Par contre sur le Userform 2 je ne suis pas arrivé à supprimer le Listbox1 ??:mad::confused:
 

Pièces jointes

  • XLD LISTBOX V01.xlsm
    44.9 KB · Affichages: 53
  • XLD LISTBOX V01.xlsm
    44.9 KB · Affichages: 66
  • XLD LISTBOX V01.xlsm
    44.9 KB · Affichages: 72

grisan29

XLDnaute Accro
Re : Rechercher Par listbox suivant deux criteres

bonjour Regueiro, Maval et le forum

depuis le temps Maval tu devrais savoir éviter les .sélect et .activate

regueiro très belle version :) sur laquelle j'ai pu enlever la listbox1 sans problème et mis en commentaire ses fonctions dans le module de classe

Pascal
 

maval

XLDnaute Barbatruc
Re : Rechercher Par listbox suivant deux criteres

Bonjour

J'ai un petit souci j'ai avance d'une colonne dans l'onglet "Données" j'ai essayé de modifier le code sans succès. Je joint mon fichier

Je vous remercie d'avance
 

Pièces jointes

  • rechercher-par-listbox-suivant-deux-criteres-listbox.xlsm
    121 KB · Affichages: 52

job75

XLDnaute Barbatruc
Re : Rechercher Par listbox suivant deux criteres

Bonjour maval, le fil,

j'ai avance d'une colonne dans l'onglet "Données" j'ai essayé de modifier le code sans succès.

Il suffisait d'ajouter un + 1 pour être sur la bonne colonne :

Code:
Private Sub ListBox1_Change()
 Dim i As Variant, j As Byte
 With Sheets("Données")
   i = Application.Match(ListBox1, .[B:B], 0)
   If IsError(i) Then i = 2 '2 => ligne vide
   For j = 1 To 12
     Me("TextBox" & j) = .Cells(i, j + 1)
   Next
 End With
 Label35 = IIf(i > 2, "Ligne " & i, "") 'après avoir créé Label35
 End Sub
A+
 

Si...

XLDnaute Barbatruc
Re : Rechercher Par listbox suivant deux criteres

salut

La moindre des choses est d'être attentif et rigoureux !
Pour des recherches, les noms ne doivent pas s'écrire n'importe comment !

Un autre exemple, plus léger, toujours avec le contrôle ListBox et l'utilisation de l'outil Tableau.
Les tableaux insérés peuvent être déplacés, varier en taille (ajout, suppression de lignes, de colonnes) sans grand impact sur les macros.

Il y a encore beaucoup à faire (il me semble t'avoir déjà donné dans un autre fichier de quoi gérer les images, non ?).
 

Pièces jointes

  • rechercher Listbox puis Listbox.xlsm
    29.9 KB · Affichages: 62

Discussions similaires

Réponses
18
Affichages
505
Réponses
4
Affichages
155