Excel VBA Recherche Partielle Résolu

Question

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. 

Configuration: Windows 7 / Firefox 3.6.6

dobo69 · Answer

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/

michel_m · Answer

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

-Tyrael- · Answer

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 :)

-Tyrael- · Answer

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.

Excel VBA Recherche Partielle

4 réponses

Votre réponse

Newsletters