Problème CurrentRegion

Le 08/03/2017 à 17:40

Bonjour à tous,

Je suis nouveau et je suis débutant sous vba. Je me suis lancé dans la création d'un excel avec plusieurs userform jusque là tous se passais bien. Cependant je rencontre un problème avec un code et c'est là que j'ai besoin de votre aide

J'ai un userform comprenant un textbox et un listbox.

Lorsque je tape un mot dans le textBox en question, la listebox va afficher toutes les données similaires dans un tableau séléctionné.

Cela fonctionne correctement mais j'aurai voulu que cette recherche soit effective pour ce tableau mais avec trois autres tableaux en même temps.

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)

Le problème survient ensuite je voudrais que la listBox prenne en compte Administration, ecole, association et comité. Pour le moment seul administration est pris en compte étant le dernier

Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm

Set Adm = Sheets("Administration")  'définit les onglets
Set Ec = Sheets("École")
Set Asso = Sheets("Association")
Set CE = Sheets("Comité d'entreprise")

TC = Ec.Range("A10").CurrentRegion
TC = Asso.Range("A10").CurrentRegion
TC = CE.Range("A10").CurrentRegion
TC = Adm.Range("A10").CurrentRegion

NL = UBound(TC, 1) 'définit le nombre de ligne NL
NC = UBound(TC, 2) 'définit le nombre de colonnes NC
Me.ListBox1.ColumnCount = NC 'définit le nombre de colonne de la ListBox1
Search.ListBox1.ColumnWidths = "45;38;130;25;90;90;65;65;130;30;130;80;80;80;80;80;80;20;22;30"

End Sub

Voici le reste de mon code

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)

If Me.TextBox1.Value = "" Then 'condition : si la Textbox1 est effacée
    Me.ListBox1.Clear 'vide la ListBox1
    Me.Label1.Caption = "" 'efface la Label1
    Exit Sub 'sort de la procédure
End If 'fin de la condition
Me.ListBox1.Clear 'vide la ListBox1
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 = 1 To NC '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
'si une erreur a été générée, message, sort de la procédure
If Err <> 0 Then Me.Label1.Caption = "Aucun client trouvé !": Exit Sub
Me.Label1.Caption = K - 1 & IIf(K - 1 = 1, " client trouvé !", " clients trouvées !")
End Sub

En espérant que quelqu'un puisse m'aider

Merci d'avance

Le 09/03/2017 à 05:40

Salut ssyla,

logique que ça n'aille pas : tu affectes TC 4 fois en 4 lignes, donc en écrasant les données précédentes immédiatement. Seul reste le dernier! Logique!

  • soit tu crées 4 tableaux : TC1, TC2, TC3, TC4 et tu fais le calcul en parallèle dans ta macro ;
  • soit tu fais une boucle supplémentaire FOR Tab = 1 to 4, où, à chaque boucle, tu affectes des données différentes à un seul TC

Ça va aller!

A+

Le 09/03/2017 à 09:36

Salut curulis57,

Merci de ta réponse, je suis sur mon excel j'ai opté pour la deuxième solution car je voulais que TC comporte plusieurs données des 4 feuilles et cette option me convient mieux.

Pour le moment ça ne fonctionne pas mais je persiste. Si je comprend bien la modification se fait à cet endroit (il faut insérer For TAB =1 to 4 ici), non? :

Set Adm = Sheets("Administration")  'définit les onglets
Set Ec = Sheets("École")
Set Asso = Sheets("Association")
Set CE = Sheets("Comité d'entreprise")

TC = Adm.Range("A10").CurrentRegion

Si tu as un peu de temps est ce que tu pourrais m'expliquer un peu plus en détail cette solution.

merci d'avance

Le 09/03/2017 à 19:44

Salut ssyla,

ce sera avec plaisir mais, en soirée!

A+

Rechercher des sujets similaires à "probleme currentregion"