Rechercher Par listbox suivant deux criteres

[maval]

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

 

[Regueiro]

Re : Rechercher Par listbox suivant deux criteres

Bonsoir Le Forum, le Fil
Voici une autre variante
Sur la Feuille Accueil UserForm Le Mien
Avec ce code plus besoin de la Feuille "Genre"
Tout est dans la Feuille "Données" Tableau1
Vous pouvez rajouter des Genres dans le Tableau sans problème.

Option Explicit
Option Base 1
Dim tablo
Public Lstob As ListObject
Public Numcol1, Numcol2
Public Décal
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")
Numcol1 = Lstob.ListColumns("Titre").Index
Numcol2 = Lstob.ListColumns("Genre").Index
If Numcol1 < Numcol2 Then
Décal = Numcol2 - Numcol1
Else
Décal = -(Numcol1 - Numcol2)
End If

MsgBox "L'Entête " & Lstob.ListColumns("Titre").Name & " se trouve en Colonne N° " _
& Numcol1 & Chr(10) & "l'Entete " & Lstob.ListColumns("Genre").Name & _
" se trouve en Colonne N° " & Numcol2 & Chr(10) _
& "Le décalage est de " & Décal & " Colonnes"

'Met les noms en mémoire dans un tableau
    'tablo = Lstob.DataBodyRange.Columns(5).Cells.Value
    'Avec cette formule tu peux rajouter des colonnes sans problème
    tablo = Lstob.ListColumns("Genre").DataBodyRange.Cells
   '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()
'Bouton quitter
'on remet le tableau sans filtre en colonne 5
'Lstob.Range.AutoFilter Field:=5
Lstob.ListColumns("Genre").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)
'Set Trouve = Lstob.DataBodyRange.Columns(1).Find(Nom, lookat:=xlWhole)
Set Trouve = Lstob.ListColumns("Titre").DataBodyRange.Cells.Find(Nom, lookat:=xlWhole)
If Trouve Is Nothing Then
MsgBox Nom & " pas trouvé dans la liste sur la feuille " & Lstob.Name
Else
ligne = Trouve.Row
MsgBox "Ligne " & ligne
    For i = 2 To 13
    '    Me("Textbox" & i) = MaBD.Cells(ligne, i)
    Me("Textbox" & i - 1) = Lstob.DataBodyRange.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
'For Each cel In Lstob.ListColumns("Titre").DataBodyRange.Cells
For Each cel In Lstob.DataBodyRange.Columns(Numcol1).Cells
    If cel.Offset(0, Décal) = Me.ComboBox1 Then
      Me.ListBox2.AddItem cel
    End If
  Next cel
  Me.ComboBox1.Visible = False
  Me.ListBox2.Visible = True
End Sub

Je pense qu'il n'y pas de bug ?

Grisan69, merci pour le commantaire.
Par contre comment as-tu enlever le ListBox1 dans USF2 ?
Bonne Soirée

 

[Regueiro]

Re : Rechercher Par listbox suivant deux criteres

Bonsoir Le Forum, Le Fil
Voilà la nouvelle mouture :
il y avait un problème avec le Numéro de Ligne dans le Tableau1 ( ListObjects )

Option Explicit
Option Base 1
Dim tablo
Public Lstob As ListObject
Public Numcol1, Numcol2
Public Décal
Public i As Integer
Private Sub UserForm_Initialize()
Dim AL As Object
Dim F As Worksheet
Dim cel
Me.ListBox2.Visible = False
Set F = Sheets("Données")
Set Lstob = F.ListObjects("Tableau1")
Numcol1 = Lstob.ListColumns("Titre").Index
Numcol2 = Lstob.ListColumns("Genre").Index
If Numcol1 < Numcol2 Then
Décal = Numcol2 - Numcol1
Else
Décal = -(Numcol1 - Numcol2)
End If

MsgBox "L'Entête " & Lstob.ListColumns("Titre").Name & " se trouve en Colonne N° " _
& Numcol1 & Chr(10) & "L'Entete " & Lstob.ListColumns("Genre").Name & _
" se trouve en Colonne N° " & Numcol2 & Chr(10) _
& "Le décalage est de " & Décal & " Colonnes"

'Met les noms en mémoire dans un tableau
    'tablo = Lstob.DataBodyRange.Columns(5).Cells.Value
    'Avec cette formule tu peux rajouter des colonnes sans problème
    tablo = Lstob.ListColumns("Genre").DataBodyRange.Cells
   '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
Me.Label35.Caption = "Mon " & Lstob.Name & " contient :" _
& Chr(10) & Lstob.DataBodyRange.Columns(1).Cells.Count _
& " Enregistrements"
Set AL = Nothing
End Sub
Private Sub CommandButton1_Click()
'Bouton quitter
Unload Me
End Sub
Private Sub CommandButton2_Click()
'Bouton Tous
Dim Ctrl As Control
ListBox2.Visible = False
Me.ComboBox1.Visible = True
'Boucle pour vider tous les Textbox
For Each Ctrl In Me.Controls
    If TypeName(Ctrl) = "TextBox" Then
        Ctrl.Text = ""
End If
Me.ComboBox1.SetFocus
Next Ctrl
End Sub
Private Sub ListBox2_Change()
Dim ligne As Long
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)
'Set Trouve = Lstob.DataBodyRange.Columns(1).Find(Nom, lookat:=xlWhole)
Set Trouve = Lstob.ListColumns("Titre").DataBodyRange.Cells.Find(Nom, lookat:=xlWhole)

If Trouve Is Nothing Then
MsgBox Nom & " pas trouvé dans la liste sur la feuille " & Lstob.Name
Else
ligne = Trouve.Row - Lstob.Range.Row
MsgBox "Ligne " & ligne
    For i = 2 To 13
    '    Me("Textbox" & i) = MaBD.Cells(ligne, i)
    Me("Textbox" & i - 1) = Lstob.DataBodyRange.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
'For Each cel In Lstob.ListColumns("Titre").DataBodyRange.Cells
For Each cel In Lstob.DataBodyRange.Columns(Numcol1).Cells
    If cel.Offset(0, Décal) = Me.ComboBox1 Then
      Me.ListBox2.AddItem cel
    End If
  Next cel
  Me.ComboBox1.Visible = False
  Me.ListBox2.Visible = True
End Sub

Je pense qu'il n'y pas de bug ?

Grisan69, merci pour le commentaire.
Par contre comment as-tu enlever le ListBox1 dans USF2 ?
Bonne Soirée

Je vous laisser tester USERFORM2
Encore un petit problème avec le bouton TOUS
A+