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
| Private O As Worksheet 'déclare la variable O (Onglet)
Private TC As Variant 'déclare la variable TC (Tableau de Cellules)
Private NL As Integer 'déclare la variable NL (Nombre de Lignes)
Private NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Private Sub UserForm_Initialize()
Me.ListBox1.ColumnCount = 10
ComboBox1.List() = Array("", "CAEN", "ROUEN", "ANGERS", "LE MANS", "TOURS", "POITIERS", "NANTES", "RENNES", "BREST", "BORDEAUX")
ComboBox2.List() = Array("", "$$$$$$$", "ùùùùùù", "******", "^^^^^^", "!!!!!!!", "::::::")
Set O = Sheets("RECAPITULATIF") 'définit l'onglet O
TC = O.Cells(2, 1).Resize(O.UsedRange.Rows.Count - 2, 17) 'définit le tableau de cellules TC
NL = UBound(TC, 1) 'définit le nombre de ligne NL
NC = 10 'définit le nombre de colonnes NC
Me.ListBox1.ColumnCount = NC 'définit le nombre de colonne de la ListBox1
End Sub
Private Sub TextBox1_Change() 'au changement dans la Textbox1
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 L (incrément)
Dim TOT() As Variant 'déclare la variable TOT (Tableau des Occcurrences Trouvées)
Dim L As Integer 'déclare la variable L (incrément)
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau de cellule TC (en partant de la seconde)
For J = 10 To 10 'boucle 2 : sur toutes les colonnes J du tableau de cellules TC
'condition : si la valeur de la TetxBox1 est contenue dans la valeur ligne I colonne J de TC
If UCase(TC(I, J)) Like "*" & UCase(Me.TextBox1.Value) & "*" Then
'redimensionne le tableau des occurrences trouvées TOT (autant de lignes que TC a de colonnes, K colonnes)
ReDim Preserve TOT(1 To NC, 1 To K)
For L = 1 To NC 'boucle 3 : sur toutes les colonnes de TC
TOT(L, K) = TC(I, L) 'alimente la ligne du tableau TOT avec la colonne du tableau TC
Next L 'prochaine colonne de la boucle 3
K = K + 1 'incrémete K (nouvelle colonne pour TOT)
Exit For 'sort de la boucle 2
End If 'fin de la condition
Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante)
'si le tableau TOT ne contient qu'une seule ligne, ajoute une seconde ligne vide (sinon les données sans dans une seule colonne...)
If UBound(TOT, 2) = 1 Then ReDim Preserve TOT(1 To NC, 1 To 2)
'alimente la ListBox1 avec le tableau TOT transposé (ligne/Colonne)
Me.ListBox1.List = Application.Transpose(TOT) 'génère une erreur si TOT est vide
End Sub
Private Sub ComboBox1_Change() 'au changement dans la Textbox1
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 L (incrément)
Dim TOT() As Variant 'déclare la variable TOT (Tableau des Occcurrences Trouvées)
Dim L As Integer 'déclare la variable L (incrément)
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau de cellule TC (en partant de la seconde)
For J = 3 To 3 'boucle 2 : sur toutes les colonnes J du tableau de cellules TC
'condition : si la valeur de la TetxBox1 est contenue dans la valeur ligne I colonne J de TC
If UCase(TC(I, J)) Like "*" & UCase(Me.ComboBox1.Value) & "*" Then
'redimensionne le tableau des occurrences trouvées TOT (autant de lignes que TC a de colonnes, K colonnes)
ReDim Preserve TOT(1 To NC, 1 To K)
For L = 1 To NC 'boucle 3 : sur toutes les colonnes de TC
TOT(L, K) = TC(I, L) 'alimente la ligne du tableau TOT avec la colonne du tableau TC
Next L 'prochaine colonne de la boucle 3
K = K + 1 'incrémete K (nouvelle colonne pour TOT)
Exit For 'sort de la boucle 2
End If 'fin de la condition
Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante)
'si le tableau TOT ne contient qu'une seule ligne, ajoute une seconde ligne vide (sinon les données sans dans une seule colonne...)
If UBound(TOT, 2) = 1 Then ReDim Preserve TOT(1 To NC, 1 To 2)
'alimente la ListBox1 avec le tableau TOT transposé (ligne/Colonne)
Me.ListBox1.List = Application.Transpose(TOT) 'génère une erreur si TOT est vide
End Sub
Private Sub ComboBox2_Change() 'au changement dans la Textbox1
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 L (incrément)
Dim TOT() As Variant 'déclare la variable TOT (Tableau des Occcurrences Trouvées)
Dim L As Integer 'déclare la variable L (incrément)
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau de cellule TC (en partant de la seconde)
For J = 6 To 6 'boucle 2 : sur toutes les colonnes J du tableau de cellules TC
'condition : si la valeur de la TetxBox1 est contenue dans la valeur ligne I colonne J de TC
If UCase(TC(I, J)) Like "*" & UCase(Me.ComboBox2.Value) & "*" Then
'redimensionne le tableau des occurrences trouvées TOT (autant de lignes que TC a de colonnes, K colonnes)
ReDim Preserve TOT(1 To NC, 1 To K)
For L = 1 To NC 'boucle 3 : sur toutes les colonnes de TC
TOT(L, K) = TC(I, L) 'alimente la ligne du tableau TOT avec la colonne du tableau TC
Next L 'prochaine colonne de la boucle 3
K = K + 1 'incrémete K (nouvelle colonne pour TOT)
Exit For 'sort de la boucle 2
End If 'fin de la condition
Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante)
'si le tableau TOT ne contient qu'une seule ligne, ajoute une seconde ligne vide (sinon les données sans dans une seule colonne...)
If UBound(TOT, 2) = 1 Then ReDim Preserve TOT(1 To NC, 1 To 2)
'alimente la ListBox1 avec le tableau TOT transposé (ligne/Colonne)
Me.ListBox1.List = Application.Transpose(TOT) 'génère une erreur si TOT est vide
End Sub |
Partager