ListView dependant de 3 ComboBox

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour à tous,

je galère un peu à faire afficher une liste de documents dépendantes de trois combobox

Afficher dans ListView
ligne i1 si la valeur de la cellule (X1,i1) = combobox1.value ou "ALL"
ligne i2 si la valeur de la cellule (X2,i2) = combobox2.value ou "ALL"
ligne i3 si la valeur de la cellule (X3,i3) = combobox3.value ou "ALL"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Sub ComboBox1_Change()
 
Dim item As ListItem
Dim derniereligne  As Integer
Dim i As Integer
Dim couleur As Variant
Dim moncritere As Variant
Dim Active As String
Application.ScreenUpdating = False
Active = ActiveSheet.Name
Sheets(Active).Select
 
AffichageSelection.ListItems.Clear
derniereligne = Range("A" & Rows.Count).End(xlUp).Row
 
For i = 12 To derniereligne
 
If ComboBox1.Value = Cells(i, 10).Value Or ComboBox1.Value = "ALL" And ComboBox2.Value = Cells(i, 8).Value Or ComboBox2.Value = "ALL" And ComboBox3.Value = Cells(i, 10).Value Or ComboBox3.Value = "ALL" Then
 
 
        Set item = AffichageSelection.ListItems.Add
 
                item.SubItems(1) = Sheets(Active).Cells(i, 1)
                item.SubItems(2) = Sheets(Active).Cells(i, 3)
                item.SubItems(3) = Sheets(Active).Cells(i, 6)
                item.SubItems(4) = Sheets(Active).Cells(i, 8)
                item.SubItems(5) = Sheets(Active).Cells(i, 10)
                item.SubItems(6) = Sheets(Active).Cells(i, 12)
        End If
 
    Next i
    Application.ScreenUpdating = True
Nbre.Caption = AffichageSelection.ListItems.Count
End Sub

Je pense que je code mal la condition....

Merci à vous tous par avance ...

Une solution serait de passer par un dictionnaire mais je ne sais pas du tout comment l'utiliser...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Option Explicit
 
Private Sub UserForm_Initialize()
 
With Me.AffichageSelection
    .View = lvwReport
    .ColumnHeaders.Add , , "A", 50
    .ColumnHeaders.Add , , "C", 50
    .ColumnHeaders.Add , , "F", 50
    .ColumnHeaders.Add , , "H", 50
    .ColumnHeaders.Add , , "J", 50
    .ColumnHeaders.Add , , "L", 50
End With
With Me.ComboBox1
    .RowSource = "Feuil2!A1:A7"
    .ListIndex = 0
End With
With Me.ComboBox2
    .RowSource = "Feuil2!B1:B8"
    .ListIndex = 0
End With
With Me.ComboBox3
    .RowSource = "Feuil2!C1:C9"
    .ListIndex = 0
End With
End Sub
 
Private Sub RemplirLst()
Dim Plage As Range, c As Range
Dim LastLig As Long
 
Application.ScreenUpdating = False
Me.AffichageSelection.ListItems.Clear
With Worksheets("Feuil1")    'A aadpter
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    If LastLig > 11 Then
        .Range("F11:J" & LastLig).AutoFilter Field:=1, Criteria1:=IIf(Me.ComboBox1.Value = "All", "*", Me.ComboBox1.Value)
        .Range("F11:J" & LastLig).AutoFilter Field:=3, Criteria1:=IIf(Me.ComboBox2.Value = "All", "*", Me.ComboBox2.Value)
        .Range("F11:J" & LastLig).AutoFilter Field:=5, Criteria1:=IIf(Me.ComboBox3.Value = "All", "*", Me.ComboBox3.Value)
 
        Set Plage = .Range("A11:A" & LastLig).SpecialCells(xlCellTypeVisible)
        If Plage.Count > 1 Then
            For Each c In Plage
                If c.Row > Plage.Row Then
                    With Me.AffichageSelection.ListItems.Add(, , c.Value)
                        .SubItems(1) = c.Offset(, 2)
                        .SubItems(2) = c.Offset(, 5)
                        .SubItems(3) = c.Offset(, 7)
                        .SubItems(4) = c.Offset(, 9)
                        .SubItems(5) = c.Offset(, 11)
                    End With
                End If
            Next c
        End If
        Set Plage = Nothing
    End If
    .AutoFilterMode = False
End With
End Sub
 
Private Sub ComboBox1_Change()
 
RemplirLst
End Sub
 
Private Sub ComboBox2_Change()
 
RemplirLst
End Sub
 
Private Sub ComboBox3_Change()
 
RemplirLst
End Sub

Merci Mercatog pour ta réponse. J'ai une erreur à la ligne 17 "la méthode autofilter de la classe range a échoué". Peut etre est-ce parce que j'ai mal modifié le code ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Private Sub RemplirLst()
Dim Plage As Range, c As Range
Dim LastLig As Long
 
Application.ScreenUpdating = False
Me.AffichageSelection.ListItems.Clear
 
 
Dim Active As String
 
Active = ActiveSheet.Name
Sheets(Active).Select
With Worksheets(Active)
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    If LastLig > 11 Then
        .Range("H11:H" & LastLig).AutoFilter Field:=1, Criteria1:=IIf(Me.ListSupplier.Value = "All", "*", Me.ListSupplier.Value)                'J'aimodifié les plages...
        .Range("J11:J" & LastLig).AutoFilter Field:=3, Criteria1:=IIf(Me.ListMetier.Value = "All", "*", Me.ListMetier.Value)
        .Range("O11:O" & LastLig).AutoFilter Field:=5, Criteria1:=IIf(Me.ValidationListe.Value = "All", "*", Me.ValidationListe.Value)
 
        Set Plage = .Range("A11:A" & LastLig).SpecialCells(xlCellTypeVisible)
        If Plage.Count > 1 Then
            For Each c In Plage
                If c.Row > Plage.Row Then
                    With Me.AffichageSelection.ListItems.Add(, , c.Value)
                        .SubItems(1) = c.Offset(, 2)
                        .SubItems(2) = c.Offset(, 5)
                        .SubItems(3) = c.Offset(, 7)
                        .SubItems(4) = c.Offset(, 9)
                        .SubItems(5) = c.Offset(, 11)
                    End With
                End If
            Next c
        End If
        Set Plage = Nothing
    End If
    .AutoFilterMode = False
End With
End Sub

14/03/2017, 23h36
mercatog

Regarde l'aide sur la méthode Range.autofilter et à quoi sert le paramètre Field

Je m'en veux de t'avoir donné un code prêt à l'emploi. Je m’ennuyais c'est pour ça

Au moins en adaptant, regardes ce que tu fais

PS. Les lignes 11 et 12 de ton "code" sont d'une affreuse atrocité, horreur, monstruosité, laideur .... Explique nous ce que font ces 2 lignes

Meci mercatog pour ton retour.

J'essaye de comprendre
Range : Zone ou le filtre sera appliqué
Field : Colonne de selection de notre critère

Ensuite critère 1 Si ListSupplier = tout alors pas de filtre sinon filtre= valeur de la ListSupplier

J'ai toujours le même message d'erreur la méthode autofilter de la classe range à échouer.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub RemplirLst()
Dim Plage As Range, c As Range
Dim LastLig As Long
 
Application.ScreenUpdating = False
Me.AffichageSelection.ListItems.Clear
 
 
Dim Active As String
 
Active = ActiveSheet.Name
Sheets(Active).Select
With Worksheets(Active)
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    If LastLig > 11 Then
 
 
        .Range("A11:P" & LastLig).AutoFilter Field:=8, Criteria1:=IIf(Me.ListSupplier.Value = "ALL", "*", Me.ListSupplier.Value)
 
       '.Range("J11:J" & LastLig).AutoFilter Field:=3, Criteria1:=IIf(Me.ListMetier.Value = "All", "*", Me.ListMetier.Value)
       '.Range("O11:O" & LastLig).AutoFilter Field:=5, Criteria1:=IIf(Me.ValidationListe.Value = "All", "*", Me.ValidationListe.Value)
 
        Set Plage = .Range("A11:A" & LastLig).SpecialCells(xlCellTypeVisible)
        If Plage.Count > 1 Then
            For Each c In Plage
                If c.Row > Plage.Row Then
                    With Me.AffichageSelection.ListItems.Add(, , c.Value)
                        .SubItems(1) = c.Offset(, 2)
                        .SubItems(2) = c.Offset(, 5)
                        .SubItems(3) = c.Offset(, 7)
                        .SubItems(4) = c.Offset(, 9)
                        .SubItems(5) = c.Offset(, 11)
                    End With
                End If
            Next c
        End If
        Set Plage = Nothing
    End If
    .AutoFilterMode = False
End With
End Sub

Par ailleurs je ne comprends pas pourquoi cette procédure démarre à l'ouverture de mon userform alors qu'elle devrait s'ouvrir lorsque je change des critères d'une des combobox....

Quant aux lignes 11 et 12, j'ai beaucoup galéré à selectionner les bons onglets sur les bons classeurs. Je copie colle des données entres différentes feuilles. Et ... c'est ainsi que je les selectionne....

Merci à vous

15/03/2017, 10h42
mercatog
Citation:

J'essaye de comprendre
Range : Zone ou le filtre sera appliqué
Field : Colonne de selection de notre critère

Tu as tout dit mais n'a pas appliqué correctement
Que veut dire la colonne 3 du range J11:Jxx

Pour les lignes 11 et 12, tu active la feuille déjà active

Citation:

j'ai beaucoup galéré à selectionner les bons onglets sur les bons classeurs. Je copie colle des données entres différentes feuilles

Pas besoin de sélectionner des feuilles pour y coller les données Exemple

Code bizarre:
Code:

1 2 3 4 5 6 worksheets("Feuil1").activate range("A2").select selection.copy worksheets("Feuil2").activate range("M1").select selection.paste
Alors qu'on préfixant les range et cells avec les feuilles auxquelles ils appartiennent, on ne souciera aucunement de la feuille active et on n'aura besoin d'activer rien.

Code précédent
Code:

1 2 worksheets("Feuil1").range("A2").copy worksheets("Feuil2").range("M1").paste
15/03/2017, 10h54
Edge38

Merci pour ta réponse

Pour l'instant je n'ai pas activé ce filtre et le message d'erreur est toujours présent... As tu une explication pour ce message ?

Pourquoi execute-t-il cette procédure avant même d'ouvrir le userform ?

en te remerciant par avance
15/03/2017, 11h48
mercatog

Je ne t'avais pas précisé que All est le premier item des 3 Combobox et à l'initialisation de l'usf, les 3 Combo sont initialisé à ce premier item.

Mets en commentaire les lignes 16, 20 et 24 de la sub UserForm_Initialize

Merci Mercatog

Je n'ai pas de ListIndex dans mon code

J'ai rempli mes Combobo ainsi

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub UserForm_Initialize()
Me.ListSupplier.Clear
Me.ListMetier.Clear
Me.ValidationListe.Clear
Me.AffichageSelection.ListItems.Clear
 
RemplissageListView
 
 
Dim x As String
Dim Cell As Range
 
'alimenter le ComboBox
ListSupplier.AddItem "ALL"
For Each Cell In Range("H12:H6000")
    ListSupplier = Cell
    'remplissage sans doublon
    If ListSupplier.ListIndex = -1 And Cell <> "" Then _
       ListSupplier.AddItem Cell
Next Cell
 
end sub

15/03/2017, 12h07
mercatog

Quand tu fais

Code:

ListSupplier = Cell

Tu appelles ListSupplier_Change qui lieu appelle RemplirLst

Utilise une autre méthode (il y en a plusieurs) pour remplir tes Combobox sans doublons Sujet récent avec 2 méthodes, à toi d'en choisir

[EDIT] :ptdr: c'était toi

Je ne comprends pas.

Je vais simplifier le problème avec une combobox.
Ma combobox ListSupplier est bien remplie.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub UserForm_Initialize()
Me.ListSupplier.Clear
Me.AffichageSelection.ListItems.Clear
RemplissageListView
 
Dim x As String
Dim Cell As Range
 
'alimenter le ComboBox
 
ListSupplier.AddItem "ALL"
For Each Cell In Range("H12:H6000")
    ListSupplier = Cell
    'remplissage sans doublon
    If ListSupplier.ListIndex = -1 And Cell <> "" Then _
       ListSupplier.AddItem Cell
Next Cell
end sub

Mon problème aujourd'hui est ma ListView "AffichageSelection". Je cherche à la remplir suivant un filtre avec la méthode que tu me proposes

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Private Sub RemplirLst()
Dim Plage As Range, c As Range
Dim LastLig As Long
 
Application.ScreenUpdating = False
Me.AffichageSelection.ListItems.Clear
 
 
Dim Active As String
 
 
With Worksheets("Projet")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    If LastLig > 11 Then
 
 
        .Range("A11:P" & LastLig).AutoFilter Field:=8, Criteria1:=IIf(Me.ListSupplier.Value = "ALL", "*", Me.ListSupplier.Value)
 
                                         ''' '.Range("J11:J" & LastLig).AutoFilter Field:=3, Criteria1:=IIf(Me.ListMetier.Value = "All", "*", Me.ListMetier.Value)
                                         ''' '.Range("O11:O" & LastLig).AutoFilter Field:=5, Criteria1:=IIf(Me.ValidationListe.Value = "All", "*", Me.ValidationListe.Value)
 
        Set Plage = .Range("A11:A" & LastLig).SpecialCells(xlCellTypeVisible)
        If Plage.Count > 1 Then
            For Each c In Plage
                If c.Row > Plage.Row Then
                    With Me.AffichageSelection.ListItems.Add(, , c.Value)
                        .SubItems(1) = c.Offset(, 2)
                        .SubItems(2) = c.Offset(, 5)
                        .SubItems(3) = c.Offset(, 7)
                        .SubItems(4) = c.Offset(, 9)
                        .SubItems(5) = c.Offset(, 11)
                    End With
                End If
            Next c
        End If
        Set Plage = Nothing
    End If
    .AutoFilterMode = False
End With
End Sub

L'erreur suivante s'affiche ligne 18: la méthode autofilter de la classe range à échouer.

15/03/2017, 13h01
mercatog

Tu n'a rien compris

avant la ligne 18, mets cette ligne

Code:

msgbox Me.ListSupplier.Value

PS. relis ceci

Citation:

Quand tu fais ceci (pour remplir ta combobox)

Sélectionner tout - Visualiser dans une fenêtre à part

Code:

ListSupplier = Cell

Tu appelles ListSupplier_Change qui lui appelle RemplirLst

Utilise une autre méthode (il y en a plusieurs) pour remplir tes Combobox sans doublons Sujet récent avec 2 méthodes, à toi d'en choisir
15/03/2017, 15h09
Edge38

Citation:

Envoyé par mercatog

Tu n'a rien compris

Oui effectivement ...

Il est vrai que je ne comprends pas.

Je suis en train d'adopter une deuxième méthode avec des filtres avancés mais je suis oblige de creer un masque pour le tri.

Je ne voulais vraiment pas passer par cette méthode et tu semblais avoir la solution.

Il ne me semble pas qu'à l'initialisation du userform je fasse appelle à la procédure ListSupplier_Change () mais à l'objet liste de la combobox dans lequel je lui rajoute la valeur portée par ma variable cell.

Avec 2 Combo

A adapter pour la 3ème

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Option Explicit
 
Dim LastLig As Long
 
Private Sub UserForm_Initialize()
 
With Me.AffichageSelection
    .View = lvwReport
    .ColumnHeaders.Add , , "A", 50
    .ColumnHeaders.Add , , "C", 50
    .ColumnHeaders.Add , , "F", 50
    .ColumnHeaders.Add , , "H", 50
    .ColumnHeaders.Add , , "J", 50
    .ColumnHeaders.Add , , "L", 50
End With
 
With Worksheets("Projet")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
 
RemplirCmbo Me.ComboBox1, 8
RemplirCmbo Me.ComboBox2, 10
End Sub
 
'Permet de remplir sans doublons la combo Cbo à partir de la colonne Col
Private Sub RemplirCmbo(ByVal Cbo As Object, Col As Integer)
Dim MonDico As Object
Dim i As Long
Dim Tb
 
With Worksheets("Projet")
    .AutoFilterMode = False
    Set MonDico = CreateObject("Scripting.Dictionary")
    Tb = .Range("A12:A" & LastLig).Offset(, Col - 1)
    MonDico("ALL") = ""
    For i = 1 To UBound(Tb)
        If Tb(i, 1) <> "" Then MonDico(Tb(i, 1)) = ""
    Next i
    Cbo.List = MonDico.keys
    Set MonDico = Nothing
End With
Cbo.ListIndex = 0
End Sub
 
'Permet de remplir la listview prenant en compte le choix des combobox
Private Sub RemplirLstview()
Dim Plage As Range, c As Range
 
Application.ScreenUpdating = False
Me.AffichageSelection.ListItems.Clear
With Worksheets("Projet")
    .AutoFilterMode = False
    .Range("H11:J" & LastLig).AutoFilter Field:=1, Criteria1:=IIf(Me.ComboBox1.Value = "ALL", "*", Me.ComboBox1.Value)
    .Range("H11:J" & LastLig).AutoFilter Field:=3, Criteria1:=IIf(Me.ComboBox2.Value = "ALL", "*", Me.ComboBox2.Value)
 
    Set Plage = .Range("A11:A" & LastLig).SpecialCells(xlCellTypeVisible)
    If Plage.Count > 1 Then
        For Each c In Plage
            If c.Row > Plage.Row Then
                With Me.AffichageSelection.ListItems.Add(, , c.Value)
                    .SubItems(1) = c.Offset(, 2)
                    .SubItems(2) = c.Offset(, 5)
                    .SubItems(3) = c.Offset(, 7)
                    .SubItems(4) = c.Offset(, 9)
                    .SubItems(5) = c.Offset(, 11)
                End With
            End If
        Next c
    End If
    Set Plage = Nothing
    .AutoFilterMode = False
End With
End Sub
 
Private Sub ComboBox1_Change()
 
RemplirLstview
End Sub
Private Sub ComboBox2_Change()
 
RemplirLstview
End Sub

Pourrais tu m'indiquer quelle est l'erreur que je fais stp?
Erreur ligne 20 : " La méthode autofilter de la classe range a échoué"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Private Sub RemplirLst()
 
 
Dim Plage As Range, c As Range
Dim LastLig As Long
 
Application.ScreenUpdating = False
Me.AffichageSelection.ListItems.Clear
 
Dim Active As String
 
Sheets("Projet").Select
With Worksheets(Active)
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
 
 
Selection.AutoFilter
   ActiveSheet.Range("A11:P" & LastLig).AutoFilter Field:=8, Criteria1:=IIf(Me.ListSupplier.Value = "ALL", "*", Me.ListSupplier.Value)
 
End With
End Sub
 '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Private Sub ListSupplier_Change()
 
 
RemplirLst
End Sub

Tu rajoutes du n'importe quoi

Remplace ce que tu viens de montrer par ceci (EXACTEMENT et sans tes interventions hasardeuses) et dis nous ce que tu obtiens comme message

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub RemplirLst()
Dim Plage As Range, c As Range
Dim LastLig As Long
 
Application.ScreenUpdating = False
Me.AffichageSelection.ListItems.Clear
With Worksheets("Projet")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
 
    MsgBox Me.ListSupplier.Value
 
    .Range("A11:P" & LastLig).AutoFilter Field:=8, Criteria1:=IIf(Me.ListSupplier.Value = "ALL", "*", Me.ListSupplier.Value)
End With
End Sub

15/03/2017, 16h20
Edge38

J'ai copié collé ce que tu m'as donné et j'ai avant même l'ouverture de mon userform

cette phrase la, à la ligne 13, dans une fenêtre d'erreur

" La méthode autofilter de la classe range a échoué"
15/03/2017, 16h24
mercatog

Bof
Joins ton fichier sans données confidentielles
15/03/2017, 18h01
Edge38

Je te fais ça tout de suite merci énormément

Merci Mercatog

Je viens de trouver à l'instant le problème. Les filtres ne fonctionnent pas dans un tableau !!!

Voilà en me basant sur l'enregistreur de macro sur l'objet ListObject

Code précédent adapté en conséquence. Que le forum m'excuse pour la solution clé en main

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
Option Explicit
 
Private Sub UserForm_Initialize()
 
With Me.AffichageSelection
    .View = lvwReport
    .ColumnHeaders.Add , , "A", 50
    .ColumnHeaders.Add , , "C", 50
    .ColumnHeaders.Add , , "F", 50
    .ColumnHeaders.Add , , "H", 50
    .ColumnHeaders.Add , , "J", 50
    .ColumnHeaders.Add , , "L", 50
End With
 
Worksheets("Projet").ListObjects("Tableau1").Range.AutoFilter
 
RemplirCmbo Me.ComboBox1, 8
RemplirCmbo Me.ComboBox2, 10
End Sub
 
Private Sub ComboBox1_Change()
 
RemplirLstview
End Sub
 
Private Sub ComboBox2_Change()
 
RemplirLstview
End Sub
 
'Permet de remplir sans doublons la combo Cbo à partir de la colonne Col
Private Sub RemplirCmbo(ByVal Cbo As Object, Col As Integer)
Dim MonDico As Object
Dim i As Long
Dim Tb
 
With Worksheets("Projet").ListObjects("Tableau1")
    .Range.AutoFilter
    Set MonDico = CreateObject("Scripting.Dictionary")
    Tb = .DataBodyRange.Columns(Col).Value
End With
 
MonDico("ALL") = ""
For i = 1 To UBound(Tb)
    If Tb(i, 1) <> "" Then MonDico(Tb(i, 1)) = ""
Next i
Tb = MonDico.keys
 
QuickSort Tb, 0, MonDico.Count - 1
Set MonDico = Nothing
 
With Cbo
    .List = Tb
    .ListIndex = 0
End With
End Sub
 
'Permet de remplir la listview prenant en compte le choix des combobox
Private Sub RemplirLstview()
Dim Plage As Range, c As Range
 
Application.ScreenUpdating = False
Me.AffichageSelection.ListItems.Clear
With Worksheets("Projet").ListObjects("Tableau1")
    With .Range
        .AutoFilter Field:=8, Criteria1:=IIf(Me.ComboBox1.Value = "ALL", "*", Me.ComboBox1.Value)
        .AutoFilter Field:=10, Criteria1:=IIf(Me.ComboBox2.Value = "ALL", "*", Me.ComboBox2.Value)
    End With
    With .DataBodyRange
        If WorksheetFunction.Subtotal(3, .Columns(1)) > 0 Then Set Plage = .Columns(1).SpecialCells(xlCellTypeVisible)
    End With
 
    If Not Plage Is Nothing Then
        For Each c In Plage
            With Me.AffichageSelection.ListItems.Add(, , c.Value)
                .SubItems(1) = c.Offset(, 2)
                .SubItems(2) = c.Offset(, 5)
                .SubItems(3) = c.Offset(, 7)
                .SubItems(4) = c.Offset(, 9)
                .SubItems(5) = c.Offset(, 11)
            End With
        Next c
    End If
    Set Plage = Nothing
    .Range.AutoFilter
End With
End Sub
 
 
'Tri rapide
Sub QuickSort(Tb, ByVal Mn As Long, ByVal Mx As Long)
Dim H As Long, L As Long, i As Long
Dim Tmp As String
 
If Mn >= Mx Then Exit Sub
i = Int((Mx - Mn + 1) * Rnd + Mn)
Tmp = Tb(i)
Tb(i) = Tb(Mn)
L = Mn
H = Mx
Do
    Do While Tb(H) >= Tmp
        H = H - 1
        If H <= L Then Exit Do
    Loop
    If H <= L Then
        Tb(L) = Tmp
        Exit Do
    End If
    Tb(L) = Tb(H)
    L = L + 1
    Do While Tb(L) < Tmp
        L = L + 1
        If L >= H Then Exit Do
    Loop
    If L >= H Then
        L = H
        Tb(H) = Tmp
        Exit Do
    End If
    Tb(H) = Tb(L)
Loop
QuickSort Tb, Mn, L - 1
QuickSort Tb, L + 1, Mx
End Sub

Voir 40 message(s) de cette discussion en une page