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
|
Private O As Worksheet 'déclare la variable O (Onglet)
Private TC As Variant 'déclare la variable TC (Tableau de Cellules)
Private Sub CommandButton1_Click()
End
End Sub
Private Sub UserForm_Initialize()
Set O = Sheets("Feuil4") 'définit l'onglet O
TC = O.Range("A1").CurrentRegion 'définit le tableau de cellules TC
Me.ListBox1.ColumnCount = UBound(TC) ', 2) + 1 'définit le nombre de colonnes 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 Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes)
Me.ListBox1.Clear 'vide la ListBox1
If Me.TextBox1.Value = "" Then Exit Sub 'si la Textbox1 est vide (effacée), sort de la procédure
K = 1 'initialise la variable K
For I = 2 To UBound(TC, 1) 'boucle 1 : sur toutes les lignes I du tableau de cellules TC (en partant de la seconde)
For J = 1 To UBound(TC, 2) 'boucle 2 : sur toutes les colonnes J du tableau de cellules TC
'condition : si la valeur ligne I colonne J de TC contient le texte de la Textbox1
If UCase(TC(I, J)) Like "*" & UCase(Me.TextBox1.Value) & "*" Then
ReDim Preserve TL(1 To UBound(TC, 2) + 1, 1 To K) 'redimensionne le tableau de lignes TL (autant de lignes que TC a de colonne plus une, K colonnes)
'TL(1, K) = I 'récupère dans la ligne 1 de TL le numéro de ligne I (cette donnée sera masquée après transposition)
For L = 2 To UBound(TC, 2) + 1 'boucle 3 : sur les lignes 2 à nombre de colonnes de TC plus une, de TL
TL(L, K) = TC(I, L - 1) 'récupere dans la ligne de TL, la valeur de la colonne de TC (=> transposition)
Next L 'prochaine ligne de la boucle 3
K = K + 1 'incrément K (=> ajoute une colonne à TL)
Exit For 'sort de la boucle 2
End If 'fin de la condition
Next J 'procjaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
If K = 1 Then Exit Sub 'si K est égale à un (=> aucune occurrence vérifiant la condition), sort de la procédure
If K = 2 Then ReDim Preserve TL(1 To UBound(TL, 1), 1 To 2) 'si K=2 (=> une seule occurrence), erdimensionne TL pour permettre la transposition
Me.ListBox1.List = Application.Transpose(TL) 'alimente la ListBox1 avec le trableau TL transposé (le numéro de ligne en colonne 1 est masqué)
End Sub |
Partager