XL 2013 Filtrer un tableau en deux listbox

anass1 · 7 Juin 2020

Bonsoir,
SVP est ce que possible filtrer un tableau en deux listbox ;
Listbox1 les entrants : c'est-à-dire seuls qui ont une date d'entrée
Listbox2 les sortants : qui ont à la fois une date d’entrée et de sortie
Merci.

_Thierry · 7 Juin 2020

Bonsoir @anass1, le Forum

Je ferai comme ceci à l'initialisation du UserForm

VB:

Option Explicit


Private Sub UserForm_Initialize()
Dim WS As Worksheet
Dim Plage As Range, Cell As Range
Dim c As Byte, x As Integer, y As Integer

Set WS = ThisWorkbook.Worksheets("Feuil1")
Set Plage = WS.Range("A2:A" & WS.Range("A1000").End(xlUp).Row)

Me.ListBox1.ColumnCount = 7
Me.ListBox2.ColumnCount = 7

For Each Cell In Plage
    If Cell.Offset(0, 6) = "" Then            'Entrée Seule
        With Me.ListBox1
        .AddItem Cell
            For c = 1 To 7
            .Column(c, x) = Cell.Offset(0, c)
            Next c
        x = x + 1
        End With
    Else                                                  'Entrée et Sortie
        With Me.ListBox2
        .AddItem Cell
            For c = 1 To 7
            .Column(c, y) = Cell.Offset(0, c)
            Next c
        y = y + 1
        End With
    
    End If
Next Cell

End Sub

Bonne soirée
@+Thierry

anass1 · 8 Juin 2020

Bonsoir @Thierry , le Forum
Merci bcp bcp
Désolé, j’ai une autre question : si vous voulez afficher "A" (colonne F) dans listbox1 et "B" dans listbox2 ?

_Thierry · 8 Juin 2020

Bonjour @anass1, le Forum

En fait tout dépend si ce critère est supplémentaire à la Date Entrée/Sortie (?)

Dans ce cas, se serait comme ceci :

VB:

Option Explicit
Private Sub UserForm_Initialize()
Dim WS As Worksheet
Dim Plage As Range, Cell As Range
Dim c As Byte, x As Integer, y As Integer

Set WS = ThisWorkbook.Worksheets("Feuil1")
Set Plage = WS.Range("A2:A" & WS.Range("A1000").End(xlUp).Row)

Me.ListBox1.ColumnCount = 7
Me.ListBox2.ColumnCount = 7

For Each Cell In Plage
    If Cell.Offset(0, 6) = "" Then                   'Entrée Seule
        If Cell.Offset(0, 5) = "A" Then
            With Me.ListBox1
            .AddItem Cell
                For c = 1 To 7
                .Column(c, x) = Cell.Offset(0, c)
                Next c
            x = x + 1
            End With
        End If
    Else                                             'Entrée et Sortie
        If Cell.Offset(0, 5) = "B" Then
            With Me.ListBox2
            .AddItem Cell
                For c = 1 To 7
                .Column(c, y) = Cell.Offset(0, c)
                Next c
            y = y + 1
            End With
        End If
    End If
Next Cell

End Sub

En fait tout dépend à l'endroit où tu mettras ces If supplémentaires ... Là ils sont en plus de la condition If Date Sortie vide ou pas...

(A toi de "jouer")

Bonne journée
@+Thierry

anass1 · 8 Juin 2020

Un grand merci à vous @Thierry,
Vous m'avez vraiment aidé
Bonne journée.

anass1 · 10 Juin 2020

Bonjour @Thierry, le Forum
Désolé pour le désagrément
Je voulais utiliser ce code pour rechercher chaque listbox, mais il recherche tout le monde (Entrants et sortants)
Merci

VB:

Option Explicit

Private Sub CommandButton1_Click()
Dim dic_liste As Object
Dim i As Integer
Dim sel_ligne As Boolean
Dim A As Integer, B As Integer
Dim Acc As Integer, Bcc As Integer
Dim Add As Integer, Bdd As Integer
Dim AaCC As Integer, BaCC As Integer

    '// création d'un dictionnaire relatif aux lignes sélectionnées de la feuille active
    Set dic_liste = CreateObject("Scripting.Dictionary")
    i = 2
    While Cells(i, "A") <> Empty
        sel_ligne = True
        If Me.ComboBox1 <> Empty And Me.ComboBox1 <> "TOUT" Then If Cells(i, "F") <> Me.ComboBox1 Then sel_ligne = False
        If Me.ComboBox2.Value = "CLIENTS" Then
        If Me.ComboBox2 <> Empty Then If Cells(i, "E") <> "CC" And Cells(i, "E") <> "DD" Then sel_ligne = False
        Else
        If Me.ComboBox2 <> Empty And Me.ComboBox2 <> "TOUT" Then If Cells(i, "E") <> Me.ComboBox2 Then sel_ligne = False
        End If

        If sel_ligne Then
            dic_liste(i) = Range(Cells(i, "A"), Cells(i, "G")).Value
            If Cells(i, "F") = "A" Then
                A = A + 1
                If Cells(i, "F") = "A" And Cells(i, "F").Offset(, -1) = "CC" Then Acc = Acc + 1
                If Cells(i, "F") = "A" And Cells(i, "F").Offset(, -1) = "DD" Then Add = Add + 1
                If Cells(i, "F") = "A" And Cells(i, "F").Offset(, -1) = "ACC" Then AaCC = AaCC + 1
            End If
            If Cells(i, "F") = "B" Then
                B = B + 1
                If Cells(i, "F") = "B" And Cells(i, "F").Offset(, -1) = "CC" Then Bcc = Bcc + 1
                If Cells(i, "F") = "B" And Cells(i, "F").Offset(, -1) = "DD" Then Bdd = Bdd + 1
                If Cells(i, "F") = "B" And Cells(i, "F").Offset(, -1) = "ACC" Then BaCC = BaCC + 1
            End If
        End If

        i = i + 1
    Wend

    '// affichage lignes sélectionnées de la feuille active
    Me.ListBox1.Clear
    If dic_liste.Count > 0 Then Me.ListBox1.Column = Application.Transpose(dic_liste.items)

    Me.TextBox1 = Acc + Add
    Me.TextBox2 = AaCC
    Me.TextBox3 = Bcc + Bdd
    Me.TextBox4 = BaCC
    Me.TextBox5 = A
    Me.TextBox6 = B
End Sub

Private Sub UserForm_Initialize()
Dim WS As Worksheet
Dim Plage As Range, Cell As Range
Dim c As Byte, x As Integer, y As Integer

Set WS = ThisWorkbook.Worksheets("Feuil1")
Set Plage = WS.Range("A2:A" & WS.Range("A1000").End(xlUp).Row)

Me.ListBox1.ColumnCount = 7
Me.ListBox2.ColumnCount = 7

For Each Cell In Plage
    If Cell.Offset(0, 6) = "" Then            'Entrée Seule
        With Me.ListBox1
        .AddItem Cell
            For c = 1 To 7
            .Column(c, x) = Cell.Offset(0, c)
            Next c
        x = x + 1
        End With
    Else                                                  'Entrée et Sortie
        With Me.ListBox2
        .AddItem Cell
            For c = 1 To 7
            .Column(c, y) = Cell.Offset(0, c)
            Next c
        y = y + 1
        End With
    
    End If
Next Cell

Me.ComboBox1.List = Array("A", "B", "TOUT")
Me.ComboBox2.List = Array("CLIENTS", "ACC", "TOUT")
Me.ComboBox3.List = Array("A", "B", "TOUT")
Me.ComboBox4.List = Array("CLIENTS", "ACC", "TOUT")
End Sub

_Thierry · 10 Juin 2020

Bonjour @anass1, le Fil, le Forum

Heuh oui, là tu as un peu tout cassé LoL !

Je suis reparti de zéro, il ne faut pas complètement changer de méthode entre l'initialise et un CommandButton, je suis resté homogène.
Dans le cas présent je ne vois pas l'utilité de passer par un dico non plus...

PS je n'aime pas du tout ta cascade de if / And / Then en "une" ligne, mélangé avec des Elses, c'est le meilleur moyen d'y perdre son latin (enfin son VBA !)

Je te laisse voir cet exemple.
Bien à toi, à vous
@+Thierry

anass1 · 10 Juin 2020

Bonsoir @Thierry, le Forum ,
Je suis vraiment désolé, je ne veux plus te déranger;
Mais je voulais insérer la combobox2 et combobox 4 et ça n'a pas marché, j'ai beaucoup essayé;
J'espérais aussi des statistiques individuelles ( entrants et sortants)

VB:

Me.ComboBox1.List = Array("A", "B", "TOUT")
Me.ComboBox2.List = Array("CC", "DD", "ACC", "TOUT")
Me.ComboBox3.List = Array("A", "B", "TOUT")
Me.ComboBox4.List = Array("CC", "DD", "ACC", "TOUT")

Code:

Private Sub CommandButton1_Click()
Dim WS As Worksheet
Dim Plage As Range, Cell As Range
Dim c As Byte, x As Integer, y As Integer

Dim i As Integer
Dim sel_ligne As Boolean
Dim A As Integer, B As Integer
Dim Acc As Integer, Bcc As Integer
Dim Add As Integer, Bdd As Integer
Dim AaCC As Integer, BaCC As Integer


If Me.ComboBox1.ListIndex = -1 Then Exit Sub
If Me.ComboBox2.ListIndex = -1 Then Exit Sub
If Me.ComboBox3.ListIndex = -1 Then Exit Sub 'Ces ComboBox ne servent pas encore, je ne sais pas où trouver CLIENT
If Me.ComboBox4.ListIndex = -1 Then Exit Sub 'Ces ComboBox ne servent pas encore, je ne sais pas où trouver CLIENT


Me.ListBox1.Clear
Me.ListBox2.Clear


Set WS = ThisWorkbook.Worksheets("Feuil1")
Set Plage = WS.Range("A2:A" & WS.Range("A1000").End(xlUp).Row)
            
            
            
  For Each Cell In Plage
    If Cell.Offset(0, 6) = "" Then            'Entrée Seule
        If Me.ComboBox1.Value <> "TOUT" Then
            If Cell.Offset(0, 5) = ComboBox1.Value Then
                With Me.ListBox1
                .AddItem Cell
                    For c = 1 To 7
                    .Column(c, x) = Cell.Offset(0, c)
                    Next c
                x = x + 1
                End With
            End If
        Else                                'si c'est TOUT
                With Me.ListBox1
                .AddItem Cell
                    For c = 1 To 7
                    .Column(c, x) = Cell.Offset(0, c)
                    Next c
                x = x + 1
                End With
        End If
    
    
    Else                                     'Entrée et Sortie
        
        If Me.ComboBox3.Value <> "TOUT" Then
            If Cell.Offset(0, 5) = ComboBox3.Value Then
                With Me.ListBox2
                .AddItem Cell
                    For c = 1 To 7
                    .Column(c, y) = Cell.Offset(0, c)
                    Next c
                y = y + 1
                End With
            End If
        Else                                 'si c'est TOUT
                With Me.ListBox2
                .AddItem Cell
                    For c = 1 To 7
                    .Column(c, y) = Cell.Offset(0, c)
                    Next c
                y = y + 1
                End With
        
        End If
    End If
          
          
          
'===========================================================================
'Je laisse mais doit être intégré au-dessus car comme ça c'est le boxon !!!
i = 2
            If Cells(i, "F") = "A" Then
                A = A + 1
                If Cells(i, "F") = "A" And Cells(i, "F").Offset(, -1) = "CC" Then Acc = Acc + 1
                If Cells(i, "F") = "A" And Cells(i, "F").Offset(, -1) = "DD" Then Add = Add + 1
                If Cells(i, "F") = "A" And Cells(i, "F").Offset(, -1) = "ACC" Then AaCC = AaCC + 1
            End If
            If Cells(i, "F") = "B" Then
                B = B + 1
                If Cells(i, "F") = "B" And Cells(i, "F").Offset(, -1) = "CC" Then Bcc = Bcc + 1
                If Cells(i, "F") = "B" And Cells(i, "F").Offset(, -1) = "DD" Then Bdd = Bdd + 1
                If Cells(i, "F") = "B" And Cells(i, "F").Offset(, -1) = "ACC" Then BaCC = BaCC + 1
            End If
        
i = i + 1
'===========================================================================


Next Cell


    Me.TextBox1 = Acc + Add
    Me.TextBox2 = AaCC
    Me.TextBox3 = Bcc + Bdd
    Me.TextBox4 = BaCC
    Me.TextBox5 = A
    Me.TextBox6 = B
End Sub

Désolé encore une fois

_Thierry · 10 Juin 2020

Bonsoir @anass1

Pour les deux combobox je ne les ai pas intégrées car je ne sais pas où se trouve "CLIENT" comme expliqué.

Pour les stats dans les TextBox, j'ai laissé dans l'état sans m'en soucier, je pensais que ca fonctionnait comme tu voulais...

Bonne soirée
@+Thierry

anass1 · 10 Juin 2020

Bonsoir @Thierry,
En fait, j'ai combiné "CC" et "DD" dans la case "clients", Mais maintenant je le mets tel quel

VB:

Me.ComboBox1.List = Array("A", "B", "TOUT")
Me.ComboBox2.List = Array("CC", "DD", "ACC", "TOUT")
Me.ComboBox3.List = Array("A", "B", "TOUT")
Me.ComboBox4.List = Array("CC", "DD", "ACC", "TOUT")

Pour les stats dans les TextBox elles affichent toujours le nombre 23

J'espère que tu es comme ça

Merci pour votre patience

_Thierry · 10 Juin 2020

Re Bonsoir

Voici une N'ième version... Je suis parti de mon exemple précédent.
Pour les stats ce n'est pas comme sur ta photo, mais ça je pense que tu t'en sortiras

Bonne soirée
@+Thierry

anass1 · 10 Juin 2020

Salutations à vous,
Il semble que ce soit la version finale

Tu es vraiment génial

Merci pour votre patience avec moi.
Bonne soirée

anass1 · 10 Juin 2020

Merci pour l'idée

Effectuez une recherche sur Excel Downloads...

XL 2013 Filtrer un tableau en deux listbox

anass1

XLDnaute Junior

Pièces jointes

_Thierry

_Thierry

XLDnaute Barbatruc

anass1

XLDnaute Junior

_Thierry

XLDnaute Barbatruc

anass1

XLDnaute Junior

anass1

XLDnaute Junior

Pièces jointes

_Thierry

XLDnaute Barbatruc

Pièces jointes

anass1

XLDnaute Junior

_Thierry

XLDnaute Barbatruc

anass1

XLDnaute Junior

Pièces jointes

_Thierry

XLDnaute Barbatruc

Pièces jointes

anass1

XLDnaute Junior

anass1

XLDnaute Junior

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums