VBA - Recherche trop longue

[Antoine C.]

Bonjour à tous,
J'utilise une TextBox de recherche pour afficher les noms recherchés dans une ListBox. Sur quelques lignes cela va très vite, mais j'ai 1319 lignes pour l'instant et le délais est très long.

Voici le code utilisé, qu'en pensez-vous ? Puis-je l'améliorer ?

    '---RECHERCHE---
    
Private Sub txtNomClient_Change() 'Recherche sur la textbox

    'Déclaration des variables
    Dim i As Long
    Dim NbLigne As Long
    
    'On doit vider la liste à chaque changement
Me.ListBox_Nom.Clear

Me.CboProjet.Clear
Me.txtNumLigne = ""
    
    'Affectation des variables
    NbLigne = Application.WorksheetFunction.CountA(Feuil1.Range("PlageNomClient"))
    
    'on teste si la TextBox à été bien saisie
    If Me.txtNomClient <> "" Then
    
        'On boucle toutes les valeurs de la plage des noms
        For i = 1 To NbLigne
        
            'on teste que la valeur de la cellule est identique au contenu de la TexteBox
            If Feuil1.Cells(i + 1, 52) Like "*" & Me.txtNomClient & "*" Then
            
                'On ajoute la valeur dans la ListBox

Me.ListBox_Nom.AddItem Feuil1.Cells(i + 1, 52)
                
                'On en profite pour compter le nombre de valeur dans la liste
Me.frmRecherche.Caption = Feuil4.Range("H66") & " Recherche : " & Me.ListBox_Nom.ListCount & " résultats"
                
            End If
        Next i
    End If

'On selectione le premier contact si il en reste 1
If Me.ListBox_Nom.ListCount = 1 Then
    Me.ListBox_Nom.Selected(0) = True
End If

End Sub

Merci pour votre aide

 

[Dranreb]

Bonjour.
Mettez une ComboBox avec ShowDropButtonWhen = 0 (ou pas) au lieu de la TextBox.
Les modules de service du xlam installé depuis le précurseur proposé dans cette ressource sont suffisamment rapides. Et la recherche intuitive y est possible.

 

[Antoine C.]

Bonjour Dranreb,

Merci pour ce retour rapide. J'avais retiré la ComboBox de la source initiale, car je voulais avoir la liste (des clients restants) en une fois.

Je vais consulter la ressource conseillée, qui est extrêmement complète !
J'espère arriver à comprendre, mes notions VBA sont relativement faibles.

 

[BOISGONTIER]

Bonjour,

Il faut utiliser des tableaux.

Exemple:

http://boisgontierjacques.free.fr/fichiers/Formulaire/RechercheMutiMotsMultiColonnesScrollETOU.xlsm

Boisgontier

 

[Dudu2]

Bonjour,
Les tableaux ça va 10 (100 ?) fois plus vite.
Et sortir de la boucle ce qui peut l'être.

    Dim TabColonne52() As Variant
    TabColonne52 = Feuil1.Cells(1, 1).Offset(1, 52 - 1).Resize(nbligne).Value

    'on teste si la TextBox à été bien saisie
    If Me.txtNomClient <> "" Then

        'On boucle toutes les valeurs de la plage des noms
        For i = 1 To nbligne
   
            'on teste que la valeur de la cellule est identique au contenu de la TexteBox
            'If Feuil1.Cells(i + 1, 52) Like "*" & Me.txtNomClient & "*" Then
            If TabColonne52(i, 1) Like "*" & Me.txtNomClient & "*" Then
       
                'On ajoute la valeur dans la ListBox

Me.ListBox_Nom.AddItem TabColonne52(i, 1)
           
                'On en profite pour compter le nombre de valeur dans la liste
'Me.frmRecherche.Caption = Feuil4.Range("H66") & " Recherche : " & Me.ListBox_Nom.ListCount & " résultats"
           
            End If
        Next i
Me.frmRecherche.Caption = Feuil4.Range("H66") & " Recherche : " & Me.ListBox_Nom.ListCount & " résultats"
    End If

 

[Antoine C.]

Messieurs,

Merci pour ces retours. Je viens de voir et prendre connaissance des différentes solutions proposées.

Après avoir consulté mon code, pour mieux comprendre et comparer, je perds apparemment du temps sur la remontée d'informations du tableau xls vers mes TextBox. Notamment sur les TextBox qui ont des actions avec _Change.
Celà produit une espèce de boucle xls => textbox => xls => etc...

J'ai isolé deux TextBox dans ce cas, il m'en reste une ou deux, mais celà semble plus rapide quand je passe de ligne en ligne.

Merci pour vos retour, je passe le sujet en "Résolu"

Bonne après midi.

PS : Je reste ouvert bien entendu à toutes propositions me permettant l'amélioration et la réflexion !

 

[Antoine C.]

Dudu2, je viens de voir ton post en même temps que ma réponse. Je vais me pencher sur ta réponse. Merci.

 

[Antoine C.]

Bonjour,
Les tableaux ça va 10 (100 ?) fois plus vite.
Et sortir de la boucle ce qui peut l'être.

    TabColonne52 = Feuil1.Cells(1, 1).Offset(1, 52).Resize(nbligne).Value

J'ai une erreur d’exécution '1004' : Erreur définie par l’application ou par l'objet avec cette ligne surlignée.

 

[Dudu2]

Désolé je t'ai dit un bêtise sur l'Offset: Offset(1, 52 - 1).
Mais ça n'explique pas l'erreur.

nbligne est bien valorisé ? Ça donne quoi au Debug ?
J'ai l'erreur 1004 si Resize(0). Donc nbligne doit être à zéro.

 

[Antoine C.]

Désolé je t'ai dit un bêtise sur l'Offset: Offset(1, 52 - 1).
Mais ça n'explique pas l'erreur.

nbligne est bien valorisé ? Ça donne quoi au Debug ?
J'ai l'erreur 1004 si Resize(0). Donc nbligne doit être à zéro.

J'ai déplacé la valorisation du NbLigne avant ton code, ce qui à permis de la prendre en compte. Voici le nouveau code, que je valide !
La recherche est d'une rapidité implacable !

Il ne me reste plus qu'à gérer mes problèmes de TextBox_Change, car la vitesse de recherche fait clairement ressortir la lenteur de remontée des informations.

Voici le code choisi :

    '---RECHERCHE---
Private Sub txtNomClient_Change() 'Recherche sur la textbox

    'Déclaration des variables
    Dim i As Long
    Dim NbLigne As Long
    
    'Affectation des variables
    NbLigne = Application.WorksheetFunction.CountA(Feuil1.Range("PlageNomClient"))
    
    Dim TabColonne52() As Variant
    TabColonne52 = Feuil1.Cells(1, 1).Offset(1, 52 - 1).Resize(NbLigne).Value
    
    'On doit vider la liste à chaque changement
    Me.ListBox_Nom.Clear
    Me.CboProjet.Clear
    Me.txtNumLigne = ""
    
'On teste si la TextBox à été bien saisie
If Me.txtNomClient <> "" Then
    
    'On boucle toutes les valeurs de la plage des noms
    For i = 1 To NbLigne
        
    'On teste que la valeur de la cellule est identique au contenu de la TexteBox
    If TabColonne52(i, 1) Like "*" & Me.txtNomClient & "*" Then
            
    'On ajoute la valeur dans la ListBox
    Me.ListBox_Nom.AddItem TabColonne52(i, 1)
    End If
        Next i

'On en profite pour compter le nombre de valeur dans la liste
Me.frmRecherche.Caption = Feuil4.Range("H66") & " Recherche : " & Me.ListBox_Nom.ListCount & " résultats"
    
End If

'On selectione le premier contact si il en reste 1
If Me.ListBox_Nom.ListCount = 1 Then
    Me.ListBox_Nom.Selected(0) = True
End If

Merci encore.