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
| Private Sub Txtrecherche_Change()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Me.ListBox1.Clear 'vide la ListBox1
If Me.Txtrecherche.Value = "" Then Exit Sub 'si la TextBox1 est effacée, sort de la procédure
K = 1 'initialise la variable K
For Each O In Worksheets 'boucle 1 sur tous les onglets O du classeur
If Len(O.Name) < 4 Then 'condition 1 : si le nom contient 3 caractères maximum
DL = O.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet O
TV = O.Range("A16:H" & DL) 'définit le tableau des valeurs TV
'*************************************************************
'Filtrer par classe = taper la classe (accepte les minuscules)
'*************************************************************
If UCase(Me.Txtrecherche.Value) = UCase(O.Name) Then 'si la TextBox1 est égale au non de l'onglet (les 2 convertis en MAJUSCULES)
For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
ReDim Preserve TL(1 To 8, 1 To K) 'redimentionne le tableau des lignes TL (8 lignes, K colonnes)
TL(1, K) = I + 15 'récupère dans la ligne 1 de TL la ligne I + 14 de la boucle (le tableau commence à la ligne 15)
TL(2, K) = O.Name 'récupère dans la ligne 2 de TL la classe (= le nom de l'onglet O)
TL(3, K) = TV(I, 2) 'récupère le code dans la ligne 3 de TL
TL(4, K) = TV(I, 3) 'récupère le Prénom dans la ligne 4 de TL
TL(5, K) = TV(I, 4) 'récupère le Nom dans la ligne 5 de TL
TL(6, K) = TV(I, 6) 'récupère le Lieu de naissance dans la ligne 6 de TL
TL(7, K) = TV(I, 7) 'récupère l'âge dans la ligne 7 de TL
TL(8, K) = TV(I, 8) 'récupère le sexe dans la ligne 8 de TL
K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
Next I 'prochaine ligne de la boucle 2
If K > 1 Then Me.ListBox1.Column = TL 'si K est supérieure à 1, alimente la Listbox1 avec le tableau TL
Me.Txtnbel.Value = Me.ListBox1.ListCount 'renvoie le nombre d'éléments dans la Textbox2
Exit Sub 'sort de la procédure
End If 'fin de la condition
'******************************************************
'filtrer par sexe taper F ou M (accepte les minuscules)
'******************************************************
If Len(Me.Txtrecherche.Value) = 1 Then 'condition 2 : si la Textbox1 ne contient qu'un seul caractère
For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
'condition 3 : si la Textbox1 est égale au sexe de la donnée ligne I colonne 8 de TV (les 2 convertis en MAJUSCULES)
If UCase(TV(I, 8)) = UCase(Me.Txtrecherche.Value) Then
ReDim Preserve TL(1 To 8, 1 To K) 'redimentionne le tableau des lignes TL (8 lignes, K colonnes)
TL(1, K) = I + 15 'récupère dans la ligne 1 de TL la ligne I+14 de la boucle (le tableau commence à la ligne 15)
TL(2, K) = O.Name 'récupère dans la ligne 2 de TL la classe (= le nom de l'onglet O)
TL(3, K) = TV(I, 2) 'récupère le code dans la ligne 3 de TL
TL(4, K) = TV(I, 3) 'récupère le Prénom dans la ligne 4 de TL
TL(5, K) = TV(I, 4) 'récupère le Nom dans la ligne 5 de TL
TL(6, K) = TV(I, 6) 'récupère le Lieu de naissance dans la ligne 6 de TL
TL(7, K) = TV(I, 7) 'récupère l'âge dans la ligne 7 de TL
TL(8, K) = TV(I, 8) 'récupère le sexe dans la ligne 8 de TL
K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
End If 'fin de la condition 3
Next I 'prochaine ligne de la boucle
Else 'sinon (condition2 : si la TextBox1 contient plus d'un seul caractère)
'*************************************************************************
'Tout autre filtre taper au moins deux caractères (accepte les minuscules)
'*************************************************************************
For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
For J = 1 To UBound(TV, 2) 'boucle 3 sur toutes les colonnes J du tableau des valeurs TV
Select Case J 'agit en fonction de J
Case 2, 3, 4, 6, 7, 8 'cas correspondant au Code, Prénom, Nom,Lieu de naissance, Âge et Sexe
'condition 3 : si la Textbox1 est égale a une de ces colonne de TV (les 2 en MAJUSCULES)
If UCase(Left(TV(I, J), Len(Me.Txtrecherche))) = UCase(Me.Txtrecherche.Value) Then
ReDim Preserve TL(1 To 8, 1 To K) 'redimentionne le tableau des lignes TL (8 lignes, K colonnes)
TL(1, K) = I + 15 'récupère dans la ligne 1 de TL la ligne I+14 de la boucle (le tableau commence à la ligne 15)
TL(2, K) = O.Name 'récupère dans la ligne 2 de TL la classe (= le nom de l'onglet O)
TL(3, K) = TV(I, 2) 'récupère le code dans la ligne 3 de TL
TL(4, K) = TV(I, 3) 'récupère le Prénom dans la ligne 4 de TL
TL(5, K) = TV(I, 4) 'récupère le Nom dans la ligne 5 de TL
TL(6, K) = TV(I, 6) 'récupère le Lieu de naissance dans la ligne 6 de TL
TL(7, K) = TV(I, 7) 'récupère l'âge dans la ligne 7 de TL
TL(8, K) = TV(I, 8) 'récupère le sexe dans la ligne 8 de TL
K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
Exit For 'sort de la boucle 3
End If 'fin de la condition 3
End Select 'fin de l'action en fonction de la colonne J
Next J 'prochaine colonne de la boucle 3
Next I 'prochaine ligne de la boucle 2
End If 'fin de la condition 2
End If 'fin de la condition 1
Next O 'prochaine onglet de la boucle 1
If K > 1 Then Me.ListBox1.Column = TL 'si K est supérieure à 1, alimente la Listbox1 avec le tableau TL
Me.Txtnbel.Value = Me.ListBox1.ListCount 'renvoie le nombre d'éléments dans la Textbox2
End Sub |
Incompatibilité de type
Répondre avec citation
Partager