VBA Excel - Comment réaliser des Recherches par Mots Clés dans un formulaire. [Résolu]

Signaler
Messages postés
64
Date d'inscription
jeudi 23 mars 2017
Statut
Membre
Dernière intervention
6 octobre 2020
-
Messages postés
64
Date d'inscription
jeudi 23 mars 2017
Statut
Membre
Dernière intervention
6 octobre 2020
-
Bonjour,
J'ai "pompé" un tuto de JP Bonneto nommé "VBA Excel - Comment réaliser des Recherches par Mots Clés dans un formulaire" en suivant strictement à la lettre son codage VBA. Bien sur, j'ai intégré mon fichier Excel en faisant bien attention de renommer mes textbox et listbox.

Or, je coince sur la recherche de la fin de la liste à parcourir...
Lorsque je tape une première lettre dans ma textbox de saisie, un message de débogage apparait et me renvoie au codage en surlignant la ligne suivante :
NbMax = Feuil1.Range("F6000").End(xlUp)

Ci dessous ce que j'ai écrit :

Private Sub Textsaisie_Change()

'Déclaration des variables
Dim j As Integer
Dim NbMax As Integer
Dim Nomcherche As String

'On réinitialise la ListBox
Me.Listchoix.Clear

'On cherche la fin de la liste à parcourir
NbMax = Feuil1.Range("F6000").End(xlUp)

'On récupère la donnée saisie dans la TextBox
Nomcherche = Me.Textsaisie.Value

'On teste que la TextBox n'est pas vide avant de faire la recherche
If Me.Textsaisie <> "" Then

'On parcoure toute la liste afin de trouver les valeurs
For j = 2 To NbMax

'On teste le contenu de la cellule en tenant en compte toutes les valeurs saisies
'grace au caractère de remplacement
If Feuil1.Cells(j, 6) Like "*" & UCase(Me.Textsaisie) & "*" Then


'On comlète la listBox des valeurs trouvées
Me.Listchoix.AddItem Feuil1.Cells(j, 6)
End If
Next j
End If
End Sub

Quelqu'un saurait-il m'expliquer d'où vient l'erreur et m'aider à la corriger ?

Merci pour votre aide

Je@n

7 réponses

Messages postés
103
Date d'inscription
mercredi 23 avril 2008
Statut
Membre
Dernière intervention
25 octobre 2020
19
Bonjour
Ne serai ce pas:
NbMax = Feuil1.Range("F6000").End(xlUp).row

A+ François
Messages postés
23600
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
30 octobre 2020
6 429
Bonjour,

ne pas hésiter à déposer un fichier de travail.
cjoint.com et coller ici le lien fourni
En plus de de ce qu'à indiqué franc38, il peut y avoir d'autres causes d'erreur.
D'ailleurs on n'a même pas le message d'erreur pour affiner.
Par exemple ton code utilise le codename, mais une feuille peut très bien avoir Feuil2 en codename et "Feuil1" en nom...

D'autre part, lire des cellules une par une est très lent.
Si tu en as beaucoup il vaut mieux lire la plage en une fois dans une variable tableau et balayer ce tableau. 100 fois plus rapide
eric
Messages postés
64
Date d'inscription
jeudi 23 mars 2017
Statut
Membre
Dernière intervention
6 octobre 2020

Bonjour et merci à vous deux pour vos réponses.
franc38, le .Row n'a pas fonctionné.

Du coup, je joins le lien pour accéder à mon fichier.

https://mon-partage.fr/f/Tk6lRX7B/

J'espère que vous pourrez m'apporter une solution, pour ma part, je suis assez limité sur le sujet.

Merci par avance

je@n
Messages postés
23600
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
30 octobre 2020
6 429
Re,

Une proposition :
Private Sub Textsaisie_Change()

    'Déclaration des variables
    Dim i As Long, j As Long
    Dim Nomcherche As String
    Dim datas, tabRech, ok As Boolean
    
    'On réinitialise la ListBox
    Me.Listchoix.Clear
    
    'On charge la liste à parcourir
    datas = [F2].Resize(Cells(Rows.Count, "F").End(xlUp).Row - 1).Value
    
    
    
    'On teste que la TextBox n'est pas vide avant de faire la recherche
    If Me.Textsaisie <> "" Then
    
        'On parcoure toute la liste afin de trouver les valeurs
        For j = 1 To UBound(datas)
            'On récupère la donnée saisie dans la TextBox
            tabRech = Split(Me.Textsaisie.Value, " ")
            ok = True
            For i = 0 To UBound(tabRech)
                Nomcherche = "*" & tabRech(i) & "*"
                'On teste le contenu de la cellule en tenant en compte toutes les valeurs saisies
                'grace au caractère de remplacement
                ok = ok And LCase(datas(j, 1)) Like Nomcherche
                If Not ok Then Exit For
            Next i
            'On complète la listBox des valeurs trouvées
            If ok Then Me.Listchoix.AddItem datas(j, 1)
        Next j
    End If
End Sub 


Dans
datas= ...
tu vois qu'on lit en une fois toute la plage.
Comme ta liste est un peu longue, j'ai amélioré : tu peux saisir plusieurs bouts de mots.
Tu peux demander
aig hub 20mm
pour avoir les aiguilles huber de 20mm
eric
Messages postés
64
Date d'inscription
jeudi 23 mars 2017
Statut
Membre
Dernière intervention
6 octobre 2020

Bonjour Eric,
A priori, cela ne marche pas totalement. J'ai copié ton codage et je n'ai plus de message de débogage. Une bonne chose.

Ce fichier avait fonctionné auparavant et la saisie d'un mot clé dans la textbox "Saisie mot clé" faisait ressortir une liste de choix de tous les produits comprenant ce mot dans la listbox "Liste de choix".
Enfin, quand je cliquais sur le produit adapté, il apparaissait dans la textbox "Produit sélectionné" afin de valider ce choix.

Actuellement, plus rien ne se passe...

Je te fais passer à nouveau le fichier avec tes codes. Ce n'est pas tout à fait le même (seule la présentation diffère), mais il était plus avancé et me fera gagner du temps quand tout sera réglé.

Peux tu y jeter un coup d'œil et si possible me dépatouiller tout cela ?

https://mon-partage.fr/f/wFFvtJ22/

Merci encore pour ton aide.

je@n
Messages postés
23600
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
30 octobre 2020
6 429
Bonjour,

Bah chez moi ça a marché direct, j'ai juste rajouté un clic en F1 pour afficher le userform.
Je t'ai mis une capture écran que tu voies le résultat.
Et un Stop en début de macro. Si elle se lance tu auras une msgbox et tu pourras faire en pas à pas pour voir si elle tourne correctement.
https://www.cjoint.com/c/JJgldWLb2md
eric
Messages postés
64
Date d'inscription
jeudi 23 mars 2017
Statut
Membre
Dernière intervention
6 octobre 2020

Bonjour,

Effectivement, ça marche même très bien.
Bravo et un immense MERCI pour ton aide.

Bien cordialement

je@n