Rechercher Par listbox suivant deux criteres

maval

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
Trier par date Trier par votes
Regueiro

Regueiro

XLDnaute Impliqué
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.

Code: 
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
 

Pièces jointes

  • XLD LISTBOX V01.xlsm
    50.4 KB · Affichages: 37
  • XLD LISTBOX V01.xlsm
    50.4 KB · Affichages: 48
  • XLD LISTBOX V01.xlsm
    50.4 KB · Affichages: 55
Vote positif 0 Vote négatif
Regueiro

Regueiro

XLDnaute Impliqué
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 )

Code: 
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
Cliquez pour agrandir...

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

Pièces jointes

  • XLD LISTBOX V01.xlsm
    49.8 KB · Affichages: 52
  • XLD LISTBOX V01.xlsm
    49.8 KB · Affichages: 55
  • XLD LISTBOX V01.xlsm
    49.8 KB · Affichages: 66
Vote positif 0 Vote négatif

Discussions similaires

L
  • Résolu(e)
XL 2016 listbox vers uderform
2
Réponses
18
Affichages
626
LJII
L
M
  • Résolu(e)
Microsoft 365 Code de tri
2
Réponses
22
Affichages
303
Dudu2
Dudu2
M
  • Résolu(e)
XL 2010 Rechercher tous les documents de travail
Réponses
10
Affichages
442
Mody200
M
B
  • Question
XL 2016 Nom du fichier Exporter
Réponses
1
Affichages
123
sylvanu
sylvanu
D
  • Question
XL 2021 2 Listes déroulantes qui ressortent les données que je veux dans un tableau
Réponses
6
Affichages
193
chris
chris
F
  • Question
XL 2013 Tri d'une listbox sur 2 combobox en cascade
2
Réponses
25
Affichages
564
franxy
F
M
  • Question
Microsoft 365 Pilotage Listbox avec des combobox
Réponses
8
Affichages
223
meca13
M
B
  • Résolu(e)
Microsoft 365 Recherche dans tableaux suivant 4 critères
2
Réponses
15
Affichages
438
Blf57
B
M
  • Résolu(e)
Microsoft 365 Code transfert
Réponses
11
Affichages
188
Marvin57
M
E
  • Question
Microsoft 365 utilisation de la fonction rechercher/remplacer pour ajouter un caractère d'annihilation par ' en amont de chaque contenu de la cellule
Réponses
2
Affichages
123
elgringo123456
E

Membres actuellement en ligne

18 membres et 117 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 209
Messages
2 086 270
Membres
103 168
dernier inscrit
isidore33