Recherche intuitive par plusieurs mots dans le désordre

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion C60a
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
C60a

C60a

XLDnaute Junior
Bonjour à tous,

Le fichier joint est tiré du code Boisgontier, que je le remercie.

L'exemple fonctionne pour une recherche intuitive par plusieurs mots dans l'ordre (Ex : "tube marron").

Mais ne l'ai pas une fois les mots recherchés sont saisis dans le désordre (Ex : "marron tube") pourtant il y a bien la ligne "Chaise tube chromé et skaï marron".

Existe-il une solution ?

Merci.
 

Pièces jointes

Dernière modification par un modérateur:
Trier par date Trier par votes
Re : Recherche intuitive par plusieurs mots dans le désordre

Bonjour C60a, JB,

Ici seuls les 2 premiers mots sont recherchés :

Code: 
Private Sub ChoixArticle_Change()
Dim s, ub%, a
s = Split(ChoixArticle): ub = IIf(UBound(s) > 1, 1, UBound(s)) '2 premiers mots
If ub > -1 Then
  If IsError(Application.Match(s(0), choix1, 0)) Then
    a = Filter(choix1, s(0), True, vbTextCompare)
    a = Filter(a, s(ub), True, vbTextCompare)
  End If
End If
ChoixArticle.List = IIf(IsArray(a), a, choix1)
If ChoixArticle.ListIndex = -1 Then ChoixArticle.DropDown Else ChoixArticle_click
End Sub
Ci joint le fichier du post #1 modifié.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Recherche intuitive par plusieurs mots dans le désordre

Bonsoir,

http://boisgontierjacques.free.fr/f..._deroulante_intuitive_multi_criteres_Form.xls

Code: 
Private Sub ComboBox1_Change()
 If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, choix, 0)) Then
   mots = Split(Trim(Me.ComboBox1), " ")
   tbl = choix
   For i = LBound(mots) To UBound(mots)
     tbl = Filter(tbl, mots(i), True, vbTextCompare)
   Next i
   Me.ComboBox1.List = tbl
   Me.ComboBox1.DropDown
 Else
   ComboBox1_Click
 End If
End Sub

JB
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Recherche intuitive par plusieurs mots dans le désordre

Re,

Avec un maximum de 5 mots recherchés :

Code: 
Private Sub ChoixArticle_Change()
Dim s, ub%, a
s = Split(ChoixArticle): ub = UBound(s)
If ub > -1 Then
  If IsError(Application.Match(s(0), choix1, 0)) Then
    a = Filter(choix1, s(0), True, vbTextCompare)
    If ub Then a = Filter(a, s(1), True, vbTextCompare)
    If ub > 1 Then a = Filter(a, s(2), True, vbTextCompare)
    If ub > 2 Then a = Filter(a, s(3), True, vbTextCompare)
    If ub > 3 Then a = Filter(a, s(4), True, vbTextCompare)
  End If
End If
ChoixArticle.List = IIf(IsArray(a), a, choix1)
If ChoixArticle.ListIndex = -1 Then ChoixArticle.DropDown Else ChoixArticle_click
End Sub
Fichier (2).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Recherche intuitive par plusieurs mots dans le désordre

Re,

Ceci fonctionne quel que soit le nombre de mots entrés :

Code: 
Private Sub ChoixArticle_Change()
If IsNumeric(Application.Match(ChoixArticle, choix1, 0)) Then _
  ChoixArticle.List = choix1: ChoixArticle_Click: Exit Sub
Dim s, a, i%
s = Split(ChoixArticle): a = choix1
For i = 0 To UBound(s)
  a = Filter(a, s(i), True, vbTextCompare)
Next
ChoixArticle.List = a: ChoixArticle.DropDown
End Sub
Edition : par ailleurs dans ChoixArticle_Click l'instruction :

Code: 
If Val(Application.Version) > 10 Then SendKeys "{f4}"
est particulièrement agaçante à partir d'Excel 2010 puisqu'elle désactive le pavé numérique 😡

Je l'ai remplacée par Application.OnTime 1, "FocusChoixFournisseur" avec dans Module1 :

Code: 
Sub FocusChoixFournisseur()
With UserForm1.ChoixFournisseur
  .SetFocus
  If .ListCount = 1 Then .ListIndex = 0 Else .DropDown
End With
End Sub
Fichier (3).

Bonne nuit.
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Recherche intuitive par plusieurs mots dans le désordre

Bonjour Boisgontier, job75,

Merci pour vos solutions, elles sont presque similaires 🙂

J'ai fait des tests et ça fonctionne très biens


job75 à dit:
par ailleurs dans ChoixArticle_Click l'instruction :

Code: 
If Val(Application.Version) > 10 Then SendKeys "{f4}"
est particulièrement agaçante à partir d'Excel 2010 puisqu'elle désactive le pavé numérique 😡
Cliquez pour agrandir...

Et moi qui me demandais pourquoi à chaque fois je me retrouve avec un pavé éteint 🙄
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Bonjour BOISGONTIER,

Ci-dessous le code que vous m'aviez transmis il y a plusieurs année et je vous en remercie.

J'essaie d'afficher un bouton situé sur le USF lorsque le résultat de la recherche ne donne rien via le TextBox1_Change.
Pourriez-vous me donner un coup de main ?

Une autre demande, pourriez-vous déclarer les variables du code ci-dessous ?

Merci pour votre aide et meilleures salutations
Philippe



VB: 
Option Explicit
Dim F, choix()
Private Sub BT_Ajouter_Contact_Click()
        If MsgBox("Inserer un nouveau Contact ?", vbYesNo + vbQuestion, "Contact") = vbYes Then
        Unload Me
            MsgBox "OUI"
            Else
            MsgBox "NON"
     End If
End Sub
Private Sub ListBox1_Click()
Dim Resultat As Variant
    Resultat = Me.ListBox1
        MsgBox Resultat
   Unload Me
End Sub
Private Sub UserForm_Initialize()
        Set F = Sheets("DATA Contacts Internes")
        Set Rng = F.Range("B3:B" & F.[B65000].End(xlUp).Row) ' Sélectionne toutes les lignes non vide, pas de ligne vide à la fin du formulaire
        choix = Application.Transpose(Rng)
        Me.ListBox1.List = choix
        Me.TextBox1.SetFocus 'Place le curseur dans la textbox
End Sub
Private Sub TextBox1_Change()
        Mots = Split(Trim(Me.TextBox1), " ") ' Permet une recherche multiple, taper les requêtes en séparant par un espace
        Tbl = choix
    For I = LBound(Mots) To UBound(Mots)
        Tbl = Filter(Tbl, Mots(I), True, vbTextCompare)
    Next I
        Me.ListBox1.List = Tbl
'Masquer ou afficher le bouton Ajouter un contact si la recherche est nul
        If ListBox1 = "" Then
        BT_Ajouter_Contact.Visible = True
    Else
        BT_Ajouter_Contact.Visible = False
    End If
End Sub
Private Sub CommandButton1_Click()
    Unload Me
End Sub





BOISGONTIER à dit:
Re : Recherche intuitive par plusieurs mots dans le désordre

Bonsoir,

http://boisgontierjacques.free.fr/f..._deroulante_intuitive_multi_criteres_Form.xls

Code: 
Private Sub ComboBox1_Change()
If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, choix, 0)) Then
   mots = Split(Trim(Me.ComboBox1), " ")
   tbl = choix
   For i = LBound(mots) To UBound(mots)
     tbl = Filter(tbl, mots(i), True, vbTextCompare)
   Next i
   Me.ComboBox1.List = tbl
   Me.ComboBox1.DropDown
Else
   ComboBox1_Click
End If
End Sub

JB
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Bonjour,

La recherche par fournisseur est un autre problème (plusieurs articles pour un fournisseur).
Il faut une listBox.

VB: 
Option Compare Text
Dim f, ligneEnreg, choix1()
Private Sub UserForm_Initialize()
    Set f = Sheets("BD")
    choix1 = Application.Transpose(f.Range("A2:A" & f.[a65000].End(xlUp).Row).Value)
    Me.ChoixArticle.List = choix1
    ligneEnreg = f.[a65000].End(xlUp).Row + 1
    Me.ChoixArticle.SetFocus
End Sub

Private Sub ChoixArticle_Change()
If Me.ChoixArticle <> "" Then
    If Me.ChoixArticle.ListIndex = -1 Then
        mots = Split(Trim(Me.ChoixArticle), " ")
        Tbl = choix1
        For Each m In mots
          Tbl = Filter(Tbl, m, True, vbTextCompare)
        Next m
        Me.ChoixArticle.List = Tbl
      Else
        ChoixArticle_click
      End If
    Else
      Me.ChoixArticle.List = choix1
    End If
    Me.ChoixArticle.DropDown
End Sub

Private Sub ChoixArticle_click()
  Set result = f.[A:A].Find(what:=Me.ChoixArticle)
  If Not result Is Nothing Then
    Me.TextBox1 = result
    For i = 2 To 3: Me("textbox" & i) = result.Offset(, i - 1): Next i
  End If
End Sub

Boisgontier
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Bonjour,

VB: 
Option Explicit
Dim f, choix(), Rng
Private Sub UserForm_Initialize()
  Set f = Sheets("DATA Contacts Internes")
  Set Rng = f.Range("B3:B" & f.[B65000].End(xlUp).Row) ' Sélectionne toutes les lignes non vide, pas de ligne vide à la fin du formulaire
  choix = Application.Transpose(Rng)
  Me.ListBox1.List = choix
  Me.TextBox1.SetFocus 'Place le curseur dans la textbox
End Sub

Private Sub ListBox1_Click()
  Dim Resultat As Variant
  Resultat = Me.ListBox1
  MsgBox Resultat
  Unload Me
End Sub

Private Sub TextBox1_Change()
  Dim Mots, Tbl, i, temp
  Mots = Split(Trim(Me.TextBox1), " ") ' Permet une recherche multiple, taper les requêtes en séparant par un espace
  Tbl = choix
  For i = LBound(Mots) To UBound(Mots)
    Tbl = Filter(Tbl, Mots(i), True, vbTextCompare)
  Next i
  Me.ListBox1.List = Tbl
  'Masquer ou afficher le bouton Ajouter un contact si la recherche est nul
  BT_Ajouter_Contact.Visible = (ListBox1.ListCount = 0)
End Sub

Private Sub BT_Ajouter_Contact_Click()
  If MsgBox("Inserer un nouveau Contact ?", vbYesNo + vbQuestion, "Contact") = vbYes Then
     Unload Me
     MsgBox "OUI"
  Else
     MsgBox "NON"
  End If
End Sub

Boisgontier
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
BOISGONTIER à dit:
Bonjour,

VB: 
Option Explicit
Dim f, choix(), Rng
Private Sub UserForm_Initialize()
  Set f = Sheets("DATA Contacts Internes")
  Set Rng = f.Range("B3:B" & f.[B65000].End(xlUp).Row) ' Sélectionne toutes les lignes non vide, pas de ligne vide à la fin du formulaire
  choix = Application.Transpose(Rng)
  Me.ListBox1.List = choix
  Me.TextBox1.SetFocus 'Place le curseur dans la textbox
End Sub

Private Sub ListBox1_Click()
  Dim Resultat As Variant
  Resultat = Me.ListBox1
  MsgBox Resultat
  Unload Me
End Sub

Private Sub TextBox1_Change()
  Dim Mots, Tbl, i, temp
  Mots = Split(Trim(Me.TextBox1), " ") ' Permet une recherche multiple, taper les requêtes en séparant par un espace
  Tbl = choix
  For i = LBound(Mots) To UBound(Mots)
    Tbl = Filter(Tbl, Mots(i), True, vbTextCompare)
  Next i
  Me.ListBox1.List = Tbl
  'Masquer ou afficher le bouton Ajouter un contact si la recherche est nul
  BT_Ajouter_Contact.Visible = (ListBox1.ListCount = 0)
End Sub

Private Sub BT_Ajouter_Contact_Click()
  If MsgBox("Inserer un nouveau Contact ?", vbYesNo + vbQuestion, "Contact") = vbYes Then
     Unload Me
     MsgBox "OUI"
  Else
     MsgBox "NON"
  End If
End Sub

Boisgontier
Cliquez pour agrandir...

Merci ça fonctionne nickel
Meilleures salutations
Philippe
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

F
  • Question Question
XL 2016 recherche de mots
2
Réponses
19
Affichages
480
job75
job75
jeff1494
  • Question Question
XL 2021 Aide pour recherche intuitive
2
Réponses
16
Affichages
939
jeff1494
jeff1494
C
  • Question Question
XL 2010 Trier des lignes par nombre de mots pertinent
Réponses
3
Affichages
792
crocrocro
C
M
  • Question Question
XL 2019 Recherche mots dans cellule et résultat dans cellule avec séparateur
2
Réponses
20
Affichages
1 K
job75
job75
S
  • Résolu(e)
Microsoft 365 Formule qui me permet de regrouper les résultats de plusieurs lignes en fonction d'une recherche par nom
Réponses
9
Affichages
242
Sylvia57
S
T
  • Question Question
XL pour MAC Recherche de mots clefs dans une cellule Texte
Réponses
2
Affichages
1 K
Tsr75a
T
P
  • Question Question
XL 2016 Recherche et somme de plusieurs critères
Réponses
2
Affichages
454
JHA
J
C
  • Question Question
XL 2019 Attribuer un % en fonction de la place d'un ingrédient dans la compo de la formule
Réponses
7
Affichages
487
TooFatBoy
TooFatBoy
looky62
  • Question Question
Microsoft 365 Code VBA Recherche par mots clés
2
Réponses
16
Affichages
2 K
job75
job75
L
  • Question Question
Microsoft 365 Effectué une recherche dans plusieurs fichiers
2 3
Réponses
42
Affichages
4 K
job75
job75
L
  • Question Question
Microsoft 365 Comparer le texte de deux colonnes (plusieurs mots/cellule) pour trouver 1 mot en commun
2 3
Réponses
37
Affichages
4 K
Staple1600
Staple1600
M
  • Question Question
Microsoft 365 recherche de doublon si les mots en doublon sont dans une suite de mots différents
2
Réponses
17
Affichages
2 K
TooFatBoy
TooFatBoy
C
  • Question Question
XL 2016 Liste intuitive dans menu déroulant
Réponses
6
Affichages
1 K
com689
C
M
  • Question Question
Microsoft 365 Recherche de mots dans plusieurs colonnes
3 4 5
Réponses
65
Affichages
5 K
moanin
M
CGU2022.
  • Résolu(e)
XL 2013 Userform recherche - Listbox double clic renvoi vers cellule
Réponses
7
Affichages
1 K
CGU2022.
CGU2022.
P
  • Résolu(e)
XL 2016 Masquer les caractères dans une boîte de dialogue de saisie de mot de passe Excel
Réponses
8
Affichages
1 K
AR MOR
A
L
  • Question Question
Microsoft 365 Userform : Combobox triée/sans doublons avec saisie intuitive/recherche multimots
Réponses
8
Affichages
3 K
AtTheOne
AtTheOne
F
  • Résolu(e)
XL 2019 Power query - Réunir le contenu de plusieurs fichiers xls dans un seul
Réponses
10
Affichages
2 K
Bernard_XLD
Bernard_XLD
C
  • Résolu(e)
Microsoft 365 recherche par mots clés dans plusieurs feuilles à partir d'un userform
Réponses
10
Affichages
1 K
CALIE
C
Y
  • Question Question
XL 2019 macro de recherche par mot et déplacement de la ligne dans un autre onglet
Réponses
2
Affichages
846
yenakisoncon
Y
Retour