Boite Recherche de mot dans fichier excel VBA

Résolu
avyrex1926 Messages postés 360 Date d'inscription dimanche 3 décembre 2006 Statut Membre Dernière intervention 3 janvier 2012 - 15 avril 2007 à 20:41
avyrex1926 Messages postés 360 Date d'inscription dimanche 3 décembre 2006 Statut Membre Dernière intervention 3 janvier 2012 - 18 avril 2007 à 00:23
Bonjour,

J'ai crée une boite de recherche VBA et j'ai de la difficulté avec la fonction FindNext.

Voici mon script:

Private Sub CommandButton1_Click()
Dim recherche As String
On Error GoTo erreur

recherche = Application.InputBox(Prompt:="Tapez votre recherche, puis cliquez sur Ok. Le curseur se déplacera alors sur votre requète", Title:="Recherche", Default:="Tapez votre recherche", Type:=2)

Cells.Find(What:=recherche, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
'(Cells.FindNext(After:=ActiveCell).Activate)
GoTo Fin
erreur:
MsgBox "Vous devez saisir une recherche"
Fin:
End Sub.

Que puis-je faire pour que la boite reste ouvert et que je puise faire FindNext s'il y a plus qu'une valeur au mot recherché?

Merci

28 réponses

mortalino Messages postés 6786 Date d'inscription vendredi 16 décembre 2005 Statut Membre Dernière intervention 21 décembre 2011 18
17 avril 2007 à 00:47
Oui, à deux détails près.

Dans l'évènement click du bouton, mets
Call Exemple_Utilisation


Et dans cette procédure, remplace "Bruce" par TonTextBox.Text


Ca c'est le premier détail, le second, faut que tu gères comment tu souhaites récupérer le résultat, là tel que mon code est fait, c'est avec Debug.Print, à toi de placer les données où tu le souhaites (car là ça s'écrit dans la fenêtre d'exécution)

@++





<hr width="100%" size="2" />

  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
  
0
avyrex1926 Messages postés 360 Date d'inscription dimanche 3 décembre 2006 Statut Membre Dernière intervention 3 janvier 2012 3
17 avril 2007 à 01:18
Merci, je fais l'essaie maintenant, je te donne des nouvelles après.
0
avyrex1926 Messages postés 360 Date d'inscription dimanche 3 décembre 2006 Statut Membre Dernière intervention 3 janvier 2012 3
17 avril 2007 à 01:44
Bon bien je vais réfléchir et essayer de
comprendre le tous, car j'ai un peux de difficulté la tous comprendre et il me
met une erreur sur
For 
i =  
LBound
(sResult) 
To 
UBound
(sResult).


Je vais réfléchir la dessus étant pas un pro en VB, car je veux vraiment le
comprendre.


Juste une question pour m'aider un peux, ça va peut-être sembler ridicule, mais
bon <!--[if gte vml 1]><v:shapetype id="_x0000_t75" coordsize="21600,21600"
o:spt="75" o:preferrelative="t" path="m@4@5l@4@11@9@11@9@5xe" filled="f"
stroked="f">
<v:stroke joinstyle="miter"/>
<v:formulas>
<v:f eqn="if lineDrawn pixelLineWidth 0"/>
<v:f eqn="sum @0 1 0"/>
<v:f eqn="sum 0 0 @1"/>
<v:f eqn="prod @2 1 2"/>
<v:f eqn="prod @3 21600 pixelWidth"/>
<v:f eqn="prod @3 21600 pixelHeight"/>
<v:f eqn="sum @0 0 1"/>
<v:f eqn="prod @6 1 2"/>
<v:f eqn="prod @7 21600 pixelWidth"/>
<v:f eqn="sum @8 21600 0"/>
<v:f eqn="prod @7 21600 pixelHeight"/>
<v:f eqn="sum @10 21600 0"/>
</v:formulas>
<v:path o:extrusionok="f" gradientshapeok="t" o:connecttype="rect"/>
<o:lock v:ext="edit" aspectratio="t"/>
</v:shapetype><v:shape id="_x0000_i1025" type="#_x0000_t75" alt="" style='width:11.25pt;
height:11.25pt'>
<v:imagedata src="file:///C:\DOCUME~1\JEAN-M~1\LOCALS~1\Temp\msohtml1\01\clip_image001.gif"
o:href="http://www.vbfrance.com/imgs2/smile_blush.gif"/>
</v:shape><![endif]--><!--[if !vml]--><!--[endif]-->


Quand tu dit : <
Dans l'évènement click du bouton, mets
Call Exemple_Utilisation >


Tu veux dire de l'insérer dans le script  Private Sub
CommandButton1_Click() ?










Je crois comprendre que la portion;














Sub 
Exemple_Utilisation()

    Dim sResult()       As String
    Dim ParseResult()   As String
    Dim i As Long
    Dim j As Long
    
    sResult  = FindWords("Bruce")
    
    For i = LBound(sResult) To UBound(sResult)
        ParseResult = Split(sResult(i), sSeparator)
        For j = LBound(ParseResult) To UBound(ParseResult)
            Debug.Print ParseResult(j)
        Next j
    Next i
    Erase sResult, ParseResult
End Sub










Doit aller aussi dans le module. Mais à chaque essaie, je fait face à un échec, donc je crois que pour le moment, je vais tous faire pour bien comprendre et surement que je vais réussir.












Merci encore et je te redonne des nouvelles le plus tôt possible.
0
mortalino Messages postés 6786 Date d'inscription vendredi 16 décembre 2005 Statut Membre Dernière intervention 21 décembre 2011 18
17 avril 2007 à 02:21
Je t'ai tout commenté, j'espère que ça t'aidera :

Public Const sSeparator =  "[SEPARATOR]"

Function LastColumn(ByVal MyRow As Long) As Integer
    LastColumn = Rows(MyRow).Find("").Column - 1
End Function

Public Function FindWords(ByVal sWord As String) As String()
        Dim rStartCell      As Range
        Dim FindWord()      As String
        Dim i               As Long:    i = 0
        Dim z               As Long
        Dim Max             As Long
        Dim oSheet          As Worksheet
        Dim ActualSheet     As String
        Dim SheetName       As String
        Dim NumRow          As String
        Dim Datas           As String
        
    ActualSheet = ActiveWorkbook.ActiveSheet.Name
' on récupère le nom de la feuille active, pour la
' resélectionner après traitement
        
    For Each oSheet In ActiveWorkbook.Worksheets
' là on fait une boucle sur toutes les feuilles du classeur

        oSheet.Select: Range("IV65536").Select: SheetName = Space(8) & "FEUILLE : " & oSheet.Name
' on sélectionne la première feuille, la cellule IV65536
' SheetName récupère le nom de la feuille pour là récupérer dans
' le tableau de donnée (la fonction, enfait récupère ces valeurs)

            On Error Resume Next
        Cells.Find(sWord).Activate
' on sélectionne la cellule qui contient le mot clé

        If Not (Err.Number = 91) Then
's'il y a une erreur, on passe au prochain Next oSheet,
' sinon, on continue le code
                ReDim Preserve FindWord(i)
' là on redimensionne le tableau (on incrémente de 1, sauf
' au départ, on part de 0 (car le 1er indice est 0, pas 1)
            
            NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
' après avoir récupéré le nom de la feuille, c'est au tour
' du numéro de la ligne

            Set rStartCell = ActiveCell
' on mémorise la cellule de départ
            
            For z = 1 To LastColumn(ActiveCell.Row)
' LastColumn(ActiveCell.Row)   renvoi la dernière colonne utilisée
' donc avec ça, on fait un balayage des donnnées de gauche à droite..

                Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row, z).Value)
' .. puis on mémorise chaque données (colonne 1, puis 2, etc.)
            Next z
            
            FindWord(i) = SheetName & sSeparator & NumRow & Datas
            i = i + 1
' ayant toutes les données de la première recherche, on inclu tout dans
' le tableau de donnée FindWord. là c'est sous cette forme :
' Feuil1[SEPARATOR]Ligne : 2[SEPARATOR]Données1[SEPARATOR]Sonnées2 etc..
            
            Do
' on initialise une boucle infinie

                Cells.Find(sWord, Cells(ActiveCell.Row + 1, 1)).Activate
' on sélectionne la cellule suivante qui contient le mot clé

                If ActiveCell.Address = Range(rStartCell.Address).Address Then Exit Do
' si c'est la même cellule que la première, on arrête la boucle

' le reste du code est le même qu'au dessus (avant le DO)

                NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
                    ReDim Preserve FindWord(i)
                
                Max = LastColumn(ActiveCell.Row)
                For z = 1 To Max
                    Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row, z).Value)
                Next z
                FindWord(i) = SheetName & sSeparator & NumRow & Datas
                i = i + 1
            Loop
        End If
    Next oSheet
    
    Sheets(ActualSheet).Select
' on resélectionne la feuille de départ

    FindWords = FindWord: Erase FindWord
' vide la mémoire des tableaux
    
End Function

Sub Exemple_Utilisation()
    Dim sResult()       As String
    Dim ParseResult()   As String
    Dim i As Long
    Dim j As Long
    
    sResult = FindWords("Bruce")
' on lance la fonction, pour rechercher Bruce, mais tu peux faire :
' sResult = FindWords(TextBox1.Text)
    
'LBound donne le plus petit indice d'un tableau (ici 0)
'UBound donne le plus grand indice d'un tableau (ici 65) [au pif]

' admettons tu as 31 résultats dans le tableau :

    For i = LBound(sResult) To UBound(sResult)
' on fait une boucle de 0 à 30
        ParseResult = Split(sResult(i), sSeparator)
'ParseResult découpe le résultat avec sSeparator, car le résultat
' est sous cette forme :
' Feuil1[SEPARATOR]Ligne : 2[SEPARATOR]Données1[SEPARATOR]Sonnées2
' il récupére en 1ere valeur "Feuil1", en 2eme "Ligne : 2", etc.

        For j = LBound(ParseResult) To UBound(ParseResult)
' maintenant on parcours chaque valeurs enregistrées, et on les affiche
' une par une dans la fenêtre Debug  (Ctrl + G pour le voir)
            Debug.Print ParseResult(j)
        Next j
    Next i
    Erase sResult, ParseResult
End Sub

' pour les code, mets tout dans un module, et dans ton UserForm
' double click sur le fameux bouton, et mets
Call Exemple_Utilisation

' pense à remplacer --> sResult = FindWords("Bruce")

~ <small> Mortalino ~ Colorisation automatique </small>

@++

<hr width ="100%" size="2" />
  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
  
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
avyrex1926 Messages postés 360 Date d'inscription dimanche 3 décembre 2006 Statut Membre Dernière intervention 3 janvier 2012 3
17 avril 2007 à 11:33
Je comprend un peut mieux la.

J'ai suivi à la lettre tes explication et dans les 3 onglet, dans la colone A3:A20, j'ai des noms de personnes et dans la colone B à AA, se trouves les itemes achetés avec les prix.

Ses items peuvent se retrouver dans plusieurs onglets d'ou cette outil de recherche.

J,ai donc ouvert un module inserant:

Public Const sSeparator = "[SEPARATOR]"

Function LastColumn(ByVal MyRow As Long) As Integer
    LastColumn = Rows(MyRow).Find("").Column - 1
End Function

Public Function FindWords(ByVal sWord As String) As String()
        Dim rStartCell      As Range
        Dim FindWord()      As String
        Dim i               As Long:    i = 0
        Dim z               As Long
        Dim Max             As Long
        Dim oSheet          As Worksheet
        Dim ActualSheet     As String
        Dim SheetName       As String
        Dim NumRow          As String
        Dim Datas           As String
        
    ActualSheet = ActiveWorkbook.ActiveSheet.Name
' on récupère le nom de la feuille active, pour la
' resélectionner après traitement
        
    For Each oSheet In ActiveWorkbook.Worksheets
' là on fait une boucle sur toutes les feuilles du classeur

        oSheet.Select: Range("IV65536").Select: SheetName = Space(8) & "FEUILLE : " & oSheet.Name
' on sélectionne la première feuille, la cellule IV65536
' SheetName récupère le nom de la feuille pour là récupérer dans
' le tableau de donnée (la fonction, enfait récupère ces valeurs)

            On Error Resume Next
        Cells.Find(sWord).Activate
' on sélectionne la cellule qui contient le mot clé

        If Not (Err.Number = 91) Then
's'il y a une erreur, on passe au prochain Next oSheet,
' sinon, on continue le code
                ReDim Preserve FindWord(i)
' là on redimensionne le tableau (on incrémente de 1, sauf
' au départ, on part de 0 (car le 1er indice est 0, pas 1)
            
            NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
' après avoir récupéré le nom de la feuille, c'est au tour
' du numéro de la ligne

            Set rStartCell = ActiveCell
' on mémorise la cellule de départ
            
            For z = 1 To LastColumn(ActiveCell.Row)
' LastColumn(ActiveCell.Row)   renvoi la dernière colonne utilisée
' donc avec ça, on fait un balayage des donnnées de gauche à droite..

                Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row, z).Value)
' .. puis on mémorise chaque données (colonne 1, puis 2, etc.)
            Next z
            
            FindWord(i) = SheetName & sSeparator & NumRow & Datas
            i = i + 1
' ayant toutes les données de la première recherche, on inclu tout dans
' le tableau de donnée FindWord. là c'est sous cette forme :
' Feuil1[SEPARATOR]Ligne : 2[SEPARATOR]Données1[SEPARATOR]Sonnées2 etc..
            
            Do
' on initialise une boucle infinie

                Cells.Find(sWord, Cells(ActiveCell.Row + 1, 1)).Activate
' on sélectionne la cellule suivante qui contient le mot clé

                If ActiveCell.Address = Range(rStartCell.Address).Address Then Exit Do
' si c'est la même cellule que la première, on arrête la boucle

' le reste du code est le même qu'au dessus (avant le DO)

                NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
                    ReDim Preserve FindWord(i)
                
                Max = LastColumn(ActiveCell.Row)
                For z = 1 To Max
                    Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row, z).Value)
                Next z
                FindWord(i) = SheetName & sSeparator & NumRow & Datas
                i = i + 1
            Loop
        End If
    Next oSheet
    
    Sheets(ActualSheet).Select
' on resélectionne la feuille de départ

    FindWords = FindWord: Erase FindWord
' vide la mémoire des tableaux
    
End Function

Sub Exemple_Utilisation()
    Dim sResult()       As String
    Dim ParseResult()   As String
    Dim i As Long
    Dim j As Long
    
    sResult = FindWords("
TextBox1.Text")
' on lance la fonction, pour rechercher Bruce, mais tu peux faire :
' sResult = FindWords(TextBox1.Text)
    
'LBound donne le plus petit indice d'un tableau (ici 0)
'UBound donne le plus grand indice d'un tableau (ici 65) [au pif]

' admettons tu as 31 résultats dans le tableau :

    For i = LBound(sResult) To UBound(sResult)
' on fait une boucle de 0 à 30
        ParseResult = Split(sResult(i), sSeparator)
'ParseResult découpe le résultat avec sSeparator, car le résultat
' est sous cette forme :
' Feuil1[SEPARATOR]Ligne : 2[SEPARATOR]Données1[SEPARATOR]Sonnées2
' il récupére en 1ere valeur "Feuil1", en 2eme "Ligne : 2", etc.

        For j = LBound(ParseResult) To UBound(ParseResult)
' maintenant on parcours chaque valeurs enregistrées, et on les affiche
' une par une dans la fenêtre Debug  (Ctrl + G pour le voir)
            Debug.Print ParseResult(j)
        Next j
    Next i
    Erase sResult, ParseResult
End Sub

Ensuite, dans mon UserForm1, avec un TextBox1 et un Bouton, en double cliquant sur le bouton, j'ai collé cette fonction:

Call Exemple_Utilisation

J'ai bien penssé à remplacer
sResult = FindWords("Bruce") par
sResult = FindWords("TextBox1.Text")

Je remarque que tous les onglets sont balayées car dans tous les onglets la cellule IV65536 et sélectionné.

Par-contre exemple quand j'inscrit dans le textbox1 du UserForm le nom ex:Alain qui est dans la feuil 1 et 3 à la ligne 7, il  m'affiche un erreur de bug sur cette phrase:

» C = LBound(sResult) To UBound(sResult)

Et de se fait, dans tous les feuils, je me trouve dans le bas completement dans la cellule IV65536 avec aucune information.

Est-ce que For i = au nom inscrit dans le TextBox1?

Si oui pourquoi il ne le prend pas?

 
0
avyrex1926 Messages postés 360 Date d'inscription dimanche 3 décembre 2006 Statut Membre Dernière intervention 3 janvier 2012 3
17 avril 2007 à 22:42
merci beaucoup pour ton endurance avec moi. lollllllll  <?xml:namespace prefix = v ns = "urn:schemas-microsoft-com:vml" /??><v:shapetype id="_x0000_t75" stroked="f" filled="f" path="m@4@5l@4@11@9@11@9@5xe" o:preferrelative="t" o:spt="75" coordsize="21600,21600"><v:stroke joinstyle="miter"></v:stroke><v:formulas><v:f eqn="if lineDrawn pixelLineWidth 0"></v:f><v:f eqn="sum @0 1 0"></v:f><v:f eqn="sum 0 0 @1"></v:f><v:f eqn="prod @2 1 2"></v:f><v:f eqn="prod @3 21600 pixelWidth"></v:f><v:f eqn="prod @3 21600 pixelHeight"></v:f><v:f eqn="sum @0 0 1"></v:f><v:f eqn="prod @6 1 2"></v:f><v:f eqn="prod @7 21600 pixelWidth"></v:f><v:f eqn="sum @8 21600 0"></v:f><v:f eqn="prod @7 21600 pixelHeight"></v:f><v:f eqn="sum @10 21600 0"></v:f></v:formulas><v:path o:connecttype="rect" gradientshapeok="t" o:extrusionok="f"></v:path><?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /??><o:lock aspectratio="t" v:ext="edit"></o:lock></v:shapetype>

Ce fut long, mais j'y suis arrivée à comprendre. Avec le temps, je vais m'améliorer c'est sure.

J’ai utilisé la ListBox et c'est super. La seule chose, est-ce normal que dans la listebox il me dit ex:



feuil1
Ligne8
Pierre
rue
ville

Feuil2
Pierre
rue
ville
Stéphane
rue
ville

Ps: S'il y a plusieurs données par feuille, les données se répetes plusieurs fois.

Est-ce normal
0
avyrex1926 Messages postés 360 Date d'inscription dimanche 3 décembre 2006 Statut Membre Dernière intervention 3 janvier 2012 3
18 avril 2007 à 00:02
Ouiiiiiiiiiiiiiiiiii,

Tous fonctionnes,

Je remarque que dans la listebox, les chiffre en valeurs dollars ne figure pas en dollard sauf si je met manuellement le signe dollars.

Donc si la cellule et en format $ 1.00, dans la listebox il va marquer 1, à moins que dans la cellule je met 1$.

Y'a t-il un moyen de le faire reconnaitre?
0
avyrex1926 Messages postés 360 Date d'inscription dimanche 3 décembre 2006 Statut Membre Dernière intervention 3 janvier 2012 3
18 avril 2007 à 00:23
Merci infiniment pour ton temps et ton aide.
0
Rejoignez-nous