Agrémenter une Listbox après vérification des lignes à ajouter

Question

Je suis en train de sécher sur une manipulation qui me semble des plus simple... J'aimerais trouvé un personne permettant de m'aider à trouver une solution sans me fournir le code tout fait !! Je ne veux pas que l'on code pour moi je veux progresser :). Ceci étant dit, voici le contexte de mon code. Le but est de fair un raccourcit depuis excel via un bouton afin d'ouvrir un fichier en réseau récupérer des infos et les agrémenter dans une listbox. Plus concrètement je souhaite que l'utilisateur entre un numéros dans une textbox (Numéros à 3 ou 4 chiffres, ex : 1456). Une fois la textbox remplit, le code va chercher ce numéros dans une page spécifique du fichier en réseau pour ensuite retourner dans la listbox tous les résultats qui trouve pour ce numéro. Ici l'exemple renvoie seulement "Beef (liver)" mais il peut renvoyé plusieurs résultats. Ceci fonctionne correctement pour le moment sur mon code que j'ai joint. Pour le moment les résultats obtenues après comparaison sont ajoutés avec la fonction "Listbox.additem cells(x,3)". Hors, j'aimerais développé le code pour qu'il ne me donne pas le résultats d'une seule cellule mais qu'il me renvoi les résultats correspondants à la ligne de la colonne (3, 6, 13, 14). Une extraction de certaines cellule de certaines colonnes de la ligne trouvée. Et si possible lorsqu'il y a plusieurs résultats qu'il ordonne les un après les autres en dessous (de manière logique). Voici le code pour le moment : Sub UserForm_QueryClose(Cancel As Integer, closemode As Integer) Dim BDD As String BDD = "Bdd MV_form605.xlsm" Workbooks(BDD).Close End Sub Sub Userform_initialize() 'Variables Dim Racine, BDD As String 'Chemin d'accès Racine = "W:\Shared\12_Support\12_1 Matrices Vierges\12_1_1 Demande + Bdd MV\" BDD = "Bdd MV_form605.xlsm" 'Ouvrir la BDD et choisir l'onglet et enlever l'update visuel Workbooks.Open Filename:=Racine & BDD, ReadOnly:=True, UpdateLinks:=3, notify:=False Application.DisplayAlerts = False Application.ScreenUpdating = False Sheets("Bdd MV").Select 'reset des box TextBox1.Text = "" ListBox1.Clear End Sub Sub textbox1_Change() 'Variables Dim Racine, BDD, Numero1, Numero2 As String Dim finalrow, x, y As Long 'Chemin d'accès Racine = "W:\Shared\12_Support\12_1 Matrices Vierges\12_1_1 Demande + Bdd MV\" BDD = "Bdd MV_form605.xlsm" 'Update seulement si un Code étude est rentré If Len(TextBox1.Value) &lt; 3 Then Exit Sub 'Gestion de la listbox ListBox1.Clear finalrow = Cells(Rows.Count, 1).End(xlUp).Row 'Remplissage de la listbox For x = 6 To finalrow If TextBox1.Text = Left(Cells(x, 1), 3) Or TextBox1.Text = Left(Cells(x, 1), 4) Then ListBox1.AddItem Cells(x, 3) End If Next x End Sub Merci d'avance pour votre collaboration :D...

ThauThème · Accepted Answer

Bonjour Ironfloflo, bonjour le forum,

Alors pour moi, expliquer prend plus de temps que coder. Alors je te propose un compromis avec un code Full Comments (comme disent les bretons). J'utilise des variables tableaux de type Variant car cela va beaucoup plus vite que de lire directement dans les cellules :

Le code :

Option Explicit 'oblige à déclarer toutes les variables
Private Racine 'déclare la variable Racine
Private CS As Workbook 'déclare la variable CS (Classeur Source)
Private OS As Worksheet 'déclare la variable OS (Onglet Source)
Private TV As Variant 'déclare la variable TV (Tableau des Valeurs)

Sub Userform_initialize() 'à l'initialisation de l'UserForm
Racine = "W:\Shared\12_Support\12_1 Matrices Vierges\12_1_1 Demande + Bdd MV\" 'définit la Racine
'définit la classeur source CS en l'ouvrant
Set CS = Workbooks.Open(Filename:=Racine & "Bdd MV_form605.xlsm", ReadOnly:=True, UpdateLinks:=3, notify:=False)
Application.DisplayAlerts = False 'masque les messages d'excel (il faudrait peut-être penser à les remettre non ?!...)
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OS = CS.Worksheets("Bdd MV") 'définit l'onglet source OS
Me.ListBox1.ColumnCount = 4 'définit le nombre de colonnes de la Listbox1
TV = OS.Range("A6").CurrentRegion 'définit le tableau des valeurs TV (peut-être à adapter selon la conception du tabelau)
End Sub

Sub textbox1_Change() 'au changement dans la TextBox1
'si tu déclares plusieurs variable dans la même ligne, chacune d'entre elles doit être typée
'Dim finalrow As Long, y As Long

Dim I As Long 'déclare la variable I (Incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim K As Long 'déclare la variable K (incrément)

If Len(TextBox1.Value) < 3 Then Exit Sub 'oblige à taper au mois trois caractères pour continuer
listbox1.Clear 'vide la ListBox1
If Me.Texbox1.Value = "" Then Exit Sub 'si la TextBox1 est effacée, sort de la procédure
For I = 6 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la sixième)
    'condition : si le texte de la TextBox1 est égal aux 3 ou 4 premiers caractères de la donnée ligne I colonne 1 de TV
    If TextBox1.Text = Left(TV(I, 1), 3) Or TextBox1.Text = Left(TV(I, 1), 4) Then
        K = K + 1 'incrémente K
        ReDim Preserve TL(1 To 4, 1 To K) 'redimensionne le tableau des lignes TL (4 lignes, K colonnes)
        TL(1, K) = TV(I, 3) 'récupère la donnée ligne I colonne 3 de TV dans la ligne 1 colonne K de TL
        TL(2, K) = TV(I, 6) 'récupère la donnée ligne I colonne 6 de TV dans la ligne 2 colonne K de TL
        TL(3, K) = TV(I, 13) 'récupère la donnée ligne I colonne 13 de TV dans la ligne 3 colonne K de TL
        TL(4, K) = TV(I, 14) 'récupère la donnée ligne I colonne 14 de TV dans la ligne 4 colonne K de TL
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
Select Case K 'agit en fonction de K
    Case 0 'si K vaut 0
        MsgBox "Aucune donnée trouvée !"
    Case 1 'si K vaut 1
        Me.listbox1.Column = Application.Transpose(TL) 'alimente la Listbox1
    Case else 'tous les autres cas
        Me.listbox1.List = Application.Transpose(TL) 'alimente la ListBox1
End Select 'fin de l'action en fonction de K
End Sub
Sub UserForm_QueryClose(Cancel As Integer, closemode As Integer) 'à la fermeture de l'UserForm
CS.Close False 'ferme le classeur source sans enregistrer
Application.DisplayAlerts = True 'Peut-être ici
End Sub