Excel VBA Recherche Partielle

Résolu
-Tyrael- Messages postés 101 Date d'inscription   Statut Membre Dernière intervention   -  
-Tyrael- Messages postés 101 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour tout le monde,

Je souhaiterai faire une recherche partielle dans une liste Excel.
Je développe, j'ai une liste de films dans une feuille excel :
colonne 1 = titre
colonne 2 = réalisateur(s)
colonne 3 = année
colonne 4 = type

J'ai fais une formulaire de recherche (par titre pour le moment) et je voudrai pouvoir effectuer une recherche ou le mot clé est présent dans le titre.

Exemple j'ai beaucoup de James Bond et quand je les classe ils sont marqué :

"James Bond 007 - Moonraker" ou encore "James Bond 007 - Octopussy"

Ce que je souhaiterai c'est que lorsque je tape "james bond" dans la recherche (ou même james) j'ai en retour tous les james bond. Pareil pour les Die Hard.

Voici mon code pour le moment le problème c'est que si je tape "james" il ne me retourne rien car ce n'est pas le titre entier. 
Private Sub cmdRechercher_Click() 
     
    Dim ligne As Integer 
    Dim LigneMax As Integer 
    Dim LigneVide As Integer 
    Dim Trouve As Integer 
     
    Trouve = 0 
    LigneVide = 0 
    LigneMax = Sheets("liste").Columns(1).Find("").Row 
     
    For ligne = 1 To LigneMax Step 1 
       'On cherche le titre sans faire attention à la casse (UCase) 
        If Not txtTitre.Text = "" And UCase(Sheets("liste").Columns(1).Rows(ligne)) = UCase(txtTitre.Text) And optTitre.Value = True Then 
            'On copy le titre trouvé 
            Sheets("liste").Rows(ligne).Copy 
            'On cherche la ligne vide de la feuille recherche pour coller le titre dedans 
            LigneVide = Sheets("Recherche").Columns(1).Find("").Row 
            Worksheets("Recherche").Activate 
            ActiveSheet.Columns(1).Rows(LigneVide).Select 
            ActiveSheet.Paste 
            Trouve = 1 
        End If 
Next ligne 
         
        If Trouve = 0 Then 
            MsgBox "Non trouvé", vbInformation, "Oups !" 
        End If 
End Sub


Donc ce code recherche dans la feuille "liste" si le mot clé (txtTitre.Text) est présent sans faire attention à la casse (UCase). Si oui il copie la ligne pour aller la coller dans la dernière ligne vide de la feuille "recherche". Si non il ouvre une message box pour dire Non trouvé.

J'ai fais une tartine pour un petit truc si ça se trouve, j'espère ne pas vous avoir noyé dans toutes mes phrases.

Merci d'avance.

4 réponses

Réponse 1 / 4
-Tyrael- Messages postés 101 Date d'inscription   Statut Membre Dernière intervention   10
 
Bonjour michel_m,

J'avoue que j'ai un peu de mal à tout comprendre.
Si tu repasse par ici pourrais tu m'expliquer un peu cette partie stp : 

With Sheets("liste") 
    For cptr = 1 To derlig 
        test = .Cells(cptr, 1) 
         If .Cells(cptr, 1) Like lettre & "*" Then 
            For col = 0 To 3 
                tablo(col, cptr_tablo) = .Cells(cptr, col + 1) 
            Next 
            cptr_tablo = cptr_tablo + 1 
            ReDim Preserve tablo(3, cptr_tablo) 
        End If 
Next 
End With


Ainsi que : .Range("A2").Resize(cptr_tablo + 1, 4) = Application.Transpose(tablo)

Merci.

Si d'autres personnes ont une solution, je suis preneur :)
1
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
Bonjour,

Si d'autres personnes ont une solution...
Ah bon! ce que je t'ai donné n'est pas une solution? pourtant, elle a été testée avec succès avant de te la proposer

Pour les explications, on verra demain !! :-)

en attendant, concernant la variable tablo, consultes ce tuto:
https://silkyroad.developpez.com/vba/tableaux/

pour l'opérateur like il compare le contenu de la cellule avec le modèle par ex ja avec le joker * retourne vrai si le contenu de la cellule commence par "ja" james ok, jaja ok, jean pas OK

quant à resize, cela consiste à créer une zone de la taille de la variable tablo: détails dans l'aide F1
pour la méthode transpose, il faudrait que tu ais à peu près assimilé le tuto cité + haut avant explications complémentaire

à demain fais moi signe lorsque tu auras potassé le tuto
0
Réponse 2 / 4
dobo69 Messages postés 1587 Date d'inscription   Statut Membre Dernière intervention   832
 
bonjour,

Je ne réponds pas tout à fait à la question :
Il existe une solution sans VBA, par formule matricielle :
http://boisgontierjacques.free.fr/fichiers/Matriciel/MatRecherche3.xls

développé et présenté sur l'excellent site de Jacques BOISGONTIER :
http://boisgontierjacques.free.fr/
0
Réponse 3 / 4
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
Bonjour

essaies cette macro (à adapter à ton classeur et userform) on cherche d'après les n premières lettres dans la liste 

Dim lettre As String 
Dim tablo 
Dim derlig as integer 
Dim cptr As Integer, col As Byte, cptr_tablo As Integer 
lettre = UCase(TextBox1.Value) 
If lettre = "" Then Exit Sub 
ReDim tablo(3, 0) 

derlig = Sheets("liste").Range("A1000").End(xlUp).Row 
With Sheets("liste") 
    For cptr = 1 To derlig 
        test = .Cells(cptr, 1) 
         If .Cells(cptr, 1) Like lettre & "*" Then 
            For col = 0 To 3 
                tablo(col, cptr_tablo) = .Cells(cptr, col + 1) 
            Next 
            cptr_tablo = cptr_tablo + 1 
            ReDim Preserve tablo(3, cptr_tablo) 
        End If 
Next 
End With 
With Sheets("cherche") 
    .Range("A2:D1000").ClearContents 
    .Range("A2").Resize(cptr_tablo + 1, 4) = Application.Transpose(tablo) 
End With



remarque:
en déclenchant la macro à partir de l'événement 
Private Sub TextBox1_Change()
la liste de tes films avec la lettre apparaitra au fur et à mesure sans avoir à cliquer sur un bouton



:-x
0
Réponse 4 / 4
-Tyrael- Messages postés 101 Date d'inscription   Statut Membre Dernière intervention   10
 
Bonjour,

Ah bon! ce que je t'ai donné n'est pas une solution? pourtant, elle a été testée avec succès avant de te la proposer

Il ne faut pas le prendre comme ça ^^ Il existe toujours plusieurs solutions à un même problème (surtout en programmation). Des plus simple et des plus compliquées.

Je vais potasser ton tuto (merci d'ailleurs) quand j'aurai un peu plus de temps (c'est du loisir ça).
En tout cas merci pour ton aide, je refais signe si j'ai des soucis sinon c'est que tout va bien.
Je mets résolu quand même pour mon sujet.
0