XL 2016 Recherche instantanée multicritère.

S

Sacha1980

XLDnaute Nouveau
Bonjour tout le monde,

J'aimerais rendre le moteur de recherche instantanée en multicritère, mais je ne sais pas comment faire, je suis débutant dans le VBA.

Pour l'instant, la recherche se concentre sur la colonne D, mais j'aimerais aussi que la recherche puisse faire en même temps sur les colonnes D, F et H.

Exemple : Si je cherche Moulin qui est un critère de la colonne H et bien qu'il me le trouve.

Est-ce possible ? Et comment faire cela ?

Je vous le fichier-test pour que vous puissiez y jeter un oeil et éventuellement inclure la bonne manière pour rendre cela possible.

Merci pour votre aide.

Sacha.
 

Pièces jointes

  • Classeurtest2.xlsm
    362.5 KB · Affichages: 29
Trier par date Trier par votes
J

JM27

XLDnaute Barbatruc
bonjour
VB: 
Private Sub TextBox1_Change()
Dim ligne As Integer
Application.ScreenUpdating = False
For ligne = 5 To 350
Sheets("Collection").Range("D" & ligne).EntireRow.Hidden = False
If Sheets("Collection").TextBox1.Value <> "" Then
    If Sheets("Collection").Cells(ligne, 4).Value Like Sheets("Collection").TextBox1.Value & "*" _
    Or Sheets("Collection").Cells(ligne, 6).Value Like Sheets("Collection").TextBox1.Value & "*" _
    Or Sheets("Collection").Cells(ligne, 8).Value Like Sheets("Collection").TextBox1.Value & "*" Then
        Sheets("Collection").Range("D" & ligne).EntireRow.Hidden = False
    Else
    
        Sheets("Collection").Range("D" & ligne).EntireRow.Hidden = True
    End If
 End If
Next ligne
Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
J

JM27

XLDnaute Barbatruc
bonjour
l'événement liée à la text box n'est pas le bon
VB: 
Private Sub TextBox1_LostFocus()
    Dim ligne As Integer
        Application.ScreenUpdating = False
        Sheets("Collection").Range("D5:D350").EntireRow.Hidden = False
        For ligne = 5 To 350
            If Sheets("Collection").TextBox1.Value <> "" Then
                If Sheets("Collection").Cells(ligne, 4).Value Like Sheets("Collection").TextBox1.Value & "*" _
                Or Sheets("Collection").Cells(ligne, 6).Value Like Sheets("Collection").TextBox1.Value & "*" _
                Or Sheets("Collection").Cells(ligne, 8).Value Like Sheets("Collection").TextBox1.Value & "*" Then
                    Sheets("Collection").Range("D" & ligne).EntireRow.Hidden = False
                Else
                
                    Sheets("Collection").Range("D" & ligne).EntireRow.Hidden = True
                End If
             End If
        Next ligne
        Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
eriiic

eriiic

XLDnaute Barbatruc
Bonjour,

sans doute un peu plus réactif en travaillant avec un tableau en mémoire :

VB: 
Private Sub TextBox1_Change()
    Dim datas, pl As Range, lig As Long, lig1 As Long, mot As String
    Application.ScreenUpdating = False
    Range("Tableau14").EntireRow.Hidden = False
    If Sheets("Collection").TextBox1.Value <> "" Then
        datas = Range("Tableau14").Value
        lig1 = Range("Tableau14").Row
        Set pl = Rows(lig1 - 1)
        For lig = 1 To UBound(datas)
            mot = "*" & TextBox1.Value & "*"
            If datas(lig, 1) Like mot Or datas(lig, 5) Like mot Or datas(lig, 5) Like mot Then
                Set pl = Union(pl, Rows(lig + lig1 - 1))
            End If
        Next lig
        Range("Tableau14").EntireRow.Hidden = True
        pl.EntireRow.Hidden = False
    End If
    Application.ScreenUpdating = True
End Sub

l'événement liée à la text box n'est pas le bon
Ca dépend si on désire une mise à jour au fil de la saisie ou pas
Cliquez pour agrandir...
 

Pièces jointes

  • Classeurtest2.xlsm
    361.2 KB · Affichages: 21
Vote positif 0 Vote négatif
S

Sacha1980

XLDnaute Nouveau
eriiiic à dit:
Bonjour,

sans doute un peu plus réactif en travaillant avec un tableau en mémoire :

VB: 
Private Sub TextBox1_Change()
    Dim datas, pl As Range, lig As Long, lig1 As Long, mot As String
    Application.ScreenUpdating = False
    Range("Tableau14").EntireRow.Hidden = False
    If Sheets("Collection").TextBox1.Value <> "" Then
        datas = Range("Tableau14").Value
        lig1 = Range("Tableau14").Row
        Set pl = Rows(lig1 - 1)
        For lig = 1 To UBound(datas)
            mot = "*" & TextBox1.Value & "*"
            If datas(lig, 1) Like mot Or datas(lig, 5) Like mot Or datas(lig, 5) Like mot Then
                Set pl = Union(pl, Rows(lig + lig1 - 1))
            End If
        Next lig
        Range("Tableau14").EntireRow.Hidden = True
        pl.EntireRow.Hidden = False
    End If
    Application.ScreenUpdating = True
End Sub
Cliquez pour agrandir...
Hello tout le monde,

Merci à tous pour vos réponses rapides.

Eriiiic : Super le code que tu as réalisé, il est même plus rapide dans la recherche que le code que j'avais et modifier par jm27 ! Bravo.

Par contre aucune recherche dans la colonne F. Il recherche bien dans les autres colonnes, mais pas dans F est-ce possible de l'inclure ?

Merci.
 
Vote positif 0 Vote négatif
eriiic

eriiic

XLDnaute Barbatruc
un copié-collé que j'ai oublié de modifier :
VB: 
If datas(lig, 1) Like mot Or datas(lig, 3) Like mot Or datas(lig, 5) Like mot Then
il y avait 2 fois la 5

Oui, le masquage se fait en one shot aussi, ça joue.
Par contre on ne peut stocker des milliers de lignes dans un range. La fin se perd et il faut travailler par blocs plus petits. Précise si ton fichier est important.
eric
 
Vote positif 0 Vote négatif
S

Sacha1980

XLDnaute Nouveau
eriiiic à dit:
un copié-collé que j'ai oublié de modifier :
VB: 
If datas(lig, 1) Like mot Or datas(lig, 3) Like mot Or datas(lig, 5) Like mot Then
il y avait 2 fois la 5

Oui, le masquage se fait en one shot aussi, ça joue.
Par contre on ne peut stocker des milliers de lignes dans un range. La fin se perd et il faut travailler par blocs plus petits. Précise si ton fichier est important.
eric
Cliquez pour agrandir...
Merci pour la modification au moins je sais à quoi correspond cette ligne de code lol.

Pour répondre à la question, pour l'instant il y a que 245 lignes, mais il est possible que le fichier devienne plus important suivant l'avancement du jeu et des Maj des dev 's, le jeu est une nouvelle version basée sur HTML5 donc récent pour tous les joueurs donc nous sommes qu'au début de l'aventure, mais si le jeu devient comme la première version en flash, oui il y aura encore beaucoup de ligne à ajouter et donc le fichier deviendra de plus en plus important.
 
Vote positif 0 Vote négatif
S

Sacha1980

XLDnaute Nouveau
eriiiic à dit:
Ok.
Je vais voir pour l'améliorer (un peu plus tard...)
L'autre inconvénient c'est que plus pl est important, plus Union() prend du temps
Cliquez pour agrandir...
Oui je comprends cela, mais bon c'est déjà plus rapide qu'avec le code que j'avais avant et cela est déjà très bien.

Par contre je viens de m'en rendre compte, est-ce possible, dans le code actuel de faire en sorte que la recherche se base sur la première lettre d'un mot ou d'une phrase ? Pour l'instant, si je tape au, il me sort tous les mots et phrase comportant au dans le mot même si au est dans le milieu d'un mot ou d'une phrase.

Merci.
 
Vote positif 0 Vote négatif
eriiic

eriiic

XLDnaute Barbatruc
La version améliorée :

VB: 
Option Compare Text

Private Sub TextBox1_Change()
    Dim datas, pl As Range, lig As Long, lig1 As Long, mot As String
    Application.ScreenUpdating = False

    If Sheets("Collection").TextBox1.Value <> "" Then
        datas = Range("Tableau14").Value
        lig1 = Range("Tableau14").Row
        mot = TextBox1.Value & "*"
        For lig = 1 To UBound(datas)
            If Not Rows(lig + lig1 - 1).Hidden Then
                If Not (datas(lig, 1) Like mot Or datas(lig, 3) Like mot Or datas(lig, 5) Like mot) Then
                    If pl Is Nothing Then Set pl = Rows(lig + lig1 - 1) Else Set pl = Union(pl, Rows(lig + lig1 - 1))
                End If
            End If
            If Not pl Is Nothing Then
                If pl.Areas.Count > 10 Then pl.EntireRow.Hidden = True: Set pl = Nothing
            End If
        Next lig
        If Not pl Is Nothing Then pl.EntireRow.Hidden = True
        Set pl = Nothing
    End If
    Application.ScreenUpdating = True
End Sub

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'On supprime le text du champs au clic sur le champs
    With TextBox1
        .Text = ""
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
    Range("Tableau14").EntireRow.Hidden = False
End Sub
eric

edit : bug signalé plus bas corrigé
 
Dernière édition:
Vote positif 0 Vote négatif
S

Sacha1980

XLDnaute Nouveau
eriiiic à dit:
La version améliorée :

VB: 
Option Compare Text

Private Sub TextBox1_Change()
    Dim datas, pl As Range, lig As Long, lig1 As Long, mot As String
    Application.ScreenUpdating = False
 
    If Sheets("Collection").TextBox1.Value <> "" Then
        datas = Range("Tableau14").Value
        lig1 = Range("Tableau14").Row
        mot = TextBox1.Value & "*"
        For lig = 1 To UBound(datas)
            If Not Rows(lig + lig1 - 1).Hidden Then
                If Not (datas(lig, 1) Like mot Or datas(lig, 3) Like mot Or datas(lig, 5) Like mot) Then
                    If pl Is Nothing Then Set pl = Rows(lig + lig1 - 1) Else Set pl = Union(pl, Rows(lig + lig1 - 1))
                End If
            End If
            If Not pl Is Nothing Then
                If pl.Areas.Count > 10 Then pl.EntireRow.Hidden = True: Set pl = Nothing
            End If
        Next lig
        pl.EntireRow.Hidden = True
        Set pl = Nothing
    End If
    Application.ScreenUpdating = True
End Sub

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'On supprime le text du champs au clic sur le champs
    With TextBox1
        .Text = ""
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
    Range("Tableau14").EntireRow.Hidden = False
End Sub
eric
Cliquez pour agrandir...
Re,

Alors il semble qu'il y a un souci avec le code !

En, effet, dès que je tape un mot, je ne peux terminer le mot en entier exemple, si je tape table, à tab j'ai une alerte de débogage.

Même chose si je me trompe de caractère dans un mot et que je revienne en arrière la fenêtre d'alerte de débogage s'ouvre et indique cela :

Erreur d'exécution '91'

Variable objet ou variable de bloc with non définie.

Et en cliquant sur débogage il m'indique en surligner jaune la ligne :

VB: 
pl.EntireRow.Hidden = True

Tu sais me dire pourquoi et éviter ce souci ?

Merci.
 
Vote positif 0 Vote négatif
eriiic

eriiic

XLDnaute Barbatruc
Oui, un cas auquel je n'avais pas pensé.
Remplace par :
VB: 
If Not pl Is Nothing Then pl.EntireRow.Hidden = True

Par contre je me demande si je n'ai pas poussé trop loin.
Pour gagner du temps, je ne reteste pas les lignes déjà masquées.
Si tu supprimes un caractère je ne ré-affiche pas les concernées. Fausse bonne idée...
Je retourne à plus plus traditionnel je pense ?

Si oui :
VB: 
Private Sub TextBox1_Change()
    Dim datas, pl As Range, lig As Long, lig1 As Long, mot As String
    Application.ScreenUpdating = False
    
    Range("Tableau14").EntireRow.Hidden = False
    If Sheets("Collection").TextBox1.Value <> "" Then
        datas = Range("Tableau14").Value
        lig1 = Range("Tableau14").Row
        mot = TextBox1.Value & "*"
        For lig = 1 To UBound(datas)
            If Not (datas(lig, 1) Like mot Or datas(lig, 3) Like mot Or datas(lig, 5) Like mot) Then
                If pl Is Nothing Then Set pl = Rows(lig + lig1 - 1) Else Set pl = Union(pl, Rows(lig + lig1 - 1))
            End If
            If Not pl Is Nothing Then
                If pl.Areas.Count > 10 Then pl.EntireRow.Hidden = True: Set pl = Nothing
            End If
        Next lig
        If Not pl Is Nothing Then pl.EntireRow.Hidden = True
        Set pl = Nothing
    End If
    Application.ScreenUpdating = True
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
Microsoft 365 SOMPROD et difficulté à trouver résultat suivants plusieurs critères
Réponses
7
Affichages
191
mcfv
M
P
  • Résolu(e)
Microsoft 365 Une Recherche spéciale avec 2 critères
Réponses
7
Affichages
322
DJunqueira
D
F
  • Question
XL 2016 Recherche valeur multicritère
Réponses
2
Affichages
374
fabriciolig
F
lestoiles1
  • Résolu(e)
XL 2013 Afficher les images comment info bulle en commentaire
Réponses
4
Affichages
252
lestoiles1
lestoiles1
J
  • Résolu(e)
XL 2016 Déplacer ma ligne dans une autre page -suivi de budget
Réponses
6
Affichages
236
jny
J
P
  • Question
Microsoft 365 crée une zone de recherche dans un tableur
Réponses
9
Affichages
479
patrick965
P
frasylest
  • Résolu(e)
Microsoft 365 Formulaire de recherche avec résultat dans autre formulaire
Réponses
2
Affichages
228
frasylest
frasylest
D
  • Question
Microsoft 365 Fonction de Recherche de différents tableaux avec plusieurs résultats ?
2
Réponses
15
Affichages
330
Cousinhub
Cousinhub
R
  • Question
XL 2010 Sélectionner une plage selon contenu d'une colonne
Réponses
2
Affichages
254
Romain31
R
B
  • Résolu(e)
Microsoft 365 Recherche dans tableaux suivant 4 critères
2
Réponses
15
Affichages
433
Blf57
B

Membres actuellement en ligne

14 membres et 355 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 198
Messages
2 086 132
Membres
103 127
dernier inscrit
willwebdesign