Objectif : Rassembler les données d'une ou plusieurs feuilles de calculs selon un ou plusieurs critères.
Un userform avec une liste "Listbox1" et un bouton "BoutonOk.
Une feuille de calculs contenant 6 colonnes renseignées (sinon modifier NbCol)
Exemple pour une feuille :
Appel :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5 Sub BoutonOk_Click() Dim NbCol as byte NbCol = 6 ChercherDansUneFeuille Textbox1, Textbox2, NbCol End subLa même procédure s'appliquant à plusieurs feuilles
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Sub ChercherDansUneFeuille(Critère1 As Variant, Critère2 As Variant, NbCol as Byte) Dim Feuille As Worksheet, Cell As Range, addDeb As String Dim Tablo() As Variant, i as integer, j as integer ListBox3.ColumnCount = NbCol Set Feuille = Worksheets("feuil1") With Feuille.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row) Set Cell = .Find(Critère1, LookIn:=xlValues, lookat:=xlPart) If Not Cell Is Nothing Then addDeb = Cell.Address Do If Cell.Offset(0, 5) = Critère2 Then i = i + 1 ReDim Preserve Tablo(NbCol, i) For j = 0 To NbCol - 1 Tablo(j, i) = Cell.Offset(0, j) Next End If Set Cell = .FindNext(Cell) Loop While Not Cell Is Nothing And Cell.Address <> addDeb End If End With For i = 1 To UBound(Tablo) Next Me.ListBox1.List = Application.Transpose(Tablo) End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5 Sub BoutonOk_Click() Dim NbCol as byte NbCol = 6 ChercherDansPlusieursFeuille Textbox1, Textbox2, NbCol End subLe code ci-dessus concerne plusieurs colonnes contigues de la feuille ce calculs.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Sub ChercherDansPlusieursFeuille(Critère1 As Variant, Critère2 As Variant, NbCol As Byte) Dim Feuille As Worksheet, Cell As Range, addDeb As String Dim Tablo() As Variant ListBox3.ColumnCount = NbCol For Each Feuille In ThisWorkbook.Worksheets If InStr(Feuille.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Address, ":") = 0 Then Exit Sub With Feuille.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row) Set Cell = .Find(Critère1, LookIn:=xlValues, lookat:=xlPart) If Not Cell Is Nothing Then addDeb = Cell.Address Do If Cell.Offset(0, 5) = Critère2 Then i = i + 1 ReDim Preserve Tablo(NbCol, i) For j = 0 To NbCol - 1 Tablo(j, i) = Cell.Offset(0, j) Next End If Set Cell = .FindNext(Cell) Loop While Not Cell Is Nothing And Cell.Address <> addDeb End If End With Next Feuille Me.ListBox1.List = Application.Transpose(Tablo) End Sub
Pour plusieurs colonnes non contigues de la feuille de calculs, il est nécessaire d'affecter les valeurs indépendamment pour chaque colonne de la liste en remplaçant la boucle de recherche comme suit
(Feuille de calculs comportant 10 colonnes renseignées ou plus)
Pour réalisé un tri selon plus de deux critères, modifier les paramètres envoyés à la procédure ainsi que la ligne suivante
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13 Do If Cell.Offset(0, 5) = Critère2 Then i = i + 1 ReDim Preserve Tablo(NbCol, i) Tablo(0, i) = Cell Tablo(1, i) = Cell.Offset(0, 2) Tablo(2, i) = Cell.Offset(0, 4) Tablo(3, i) = Cell.Offset(0, 5) Tablo(4, i) = Cell.Offset(0, 7) Tablo(5, i) = Cell.Offset(0, 9) End If Set Cell = .FindNext(Cell) Loop While Not Cell Is Nothing And Cell.Address <> addDeb
selon ce modèleIf Cell.Offset(0, 5) = Critère2 Then
Une explication sur
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 If Cell.Offset(0, 5) = Critère2 and _ Cell.Offset(0, 7) = Critère3 or _ Cell.Offset(0, 6) = Critère4 ...Then
ListBoxn.list demande une plage de cellules selon la syntaxe object.List(row, column)Me.ListBox1.List = Application.Transpose(Tablo)
Le problème :
Le tableau utilisé pour renseigner la liste est redimensionnée.
Seule la seconde dimension d'un tableau peut être redimensionné.
Or la première dimension du tableau utilisé correspond au N° de colonne de la liste (fixée au départ) et la seconde dimension "redimensionnée" correspond aux N° de ligne de la liste.
On obtient donc Tablo(column, row) au lieu de Tablo(row, column)
Pour convertir le tableau, il est donc nécessaire d'en inverser les termes. De là l'utilisation de la fonction de la feuille de calculs Transpose.
Application.Transpose(Tablo) "renvoie une plage horizontale de cellules sous forme de plage verticale, ou vice versa" (F1 dans Excel)
Partager