Problème fonction recherche vba

Résolu

avyrex1926 Messages postés 360 Date d'inscription dimanche 3 décembre 2006 Statut Membre Dernière intervention 3 janvier 2012 - 27 juil. 2007 à 23:10
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 - 28 juil. 2007 à 18:22

Bonjour à tous,

J'ai une petite modification à faire dans se script mais j'ai de la difficulté à trouver ou est le problème.

Je ne veux pas que la recherche se face dans tous les feuil, mais juste dans la basse de données.

Voici le script:
<hr size="2" width="100%" />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

        '************************************
        Dim NoDupes         As New Collection
        '************************************


    ActualSheet = ActiveWorkbook.ActiveSheet.Name


    For Each oSheet In ActiveWorkbook.Worksheets

        oSheet.Select: Range("U65536").Select: SheetName = Space(8) & "FEUILLE : " & oSheet.Name

            On Error Resume Next
        Cells.Find(sWord).Activate

        If Not (Err.Number = 91) Then

                ReDim Preserve FindWord(i)


            NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)

            Set rStartCell = ActiveCell


            For z = 1 To LastColumn(ActiveCell.Row)

                Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row, z).Text)

            Next z

            FindWord(i) = SheetName & sSeparator & NumRow & sSeparator & Datas & sSeparator
            i = i + 1


            Do

                Cells.Find(sWord, Cells(ActiveCell.Row + 1, 1)).Activate

                If ActiveCell.Address = Range(rStartCell.Address).Address Then Exit Do

                NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
                    ReDim Preserve FindWord(i)

                Max = LastColumn(ActiveCell.Row)
                For z = 1 To Max

                '*******************************************
                    NoDupes.Add Cells(ActiveCell.Row, z).Value, CStr(Cells(ActiveCell.Row, z).Text)
                    If Err.Number = 457 Then Err.Clear: Exit For
                    '*******************************************

                    Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row, z).Text)
                Next z
                FindWord(i) = SheetName & sSeparator & NumRow & sSeparator & Datas & sSeparator
                i = i + 1
            Loop
        End If
    Next oSheet

    Sheets(ActualSheet).Select

    FindWords = FindWord: Erase FindWord

'*************************
    For i = NoDupes.Count To 1 Step -1
        NoDupes.Remove (i)
    Next i
Set NoDupes = Nothing

    '*************************


End Function
<hr size="2" width="100%" />Merci de votre aide

A voir également:

Problème fonction recherche vba
Doevents vba - Conseils pratiques -Visual Basic / VB.NET
Fonction mod vba - Forum Visual Basic 6
Le Modulo en VB6 ✓ - Forum Visual Basic 6
Maths : modulo ✓ - Forum Visual Basic
Byval vba - Conseils pratiques -Visual Basic / VB.NET

27 réponses

Réponse 21 / 27

cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
28 juil. 2007 à 15:51

Salut à toi, habitant de la Rive Sud ... ainsi qu'à toi Mortalino.

Voici un autre exemple utilisant Find et FindNext
Chaque enregistrement du tableau résultat est une ligne trouvée dont les cellules sont séparées par le séparateur mis en paramètre. Si tu veux que chaque cellule soit un item du tableau, il faudra le redimensionner dans la recherche horizontale (dans la boucle For I ...Next)

Option Explicit

Sub Départ()
    Dim Tableau As Variant

    Tableau = RechercheMot("RONA", ";") ' ou RechercheMot("Rona", vbCrLf)

    If Tableau(0) = "" Then
        MsgBox "Aucune valeur trouvée"
    Else
        MsgBox Tableau(0) ' pour visualiser le résultat d'une ligne
    End If
End Sub

Function RechercheMot(Mot As String, Séparateur As String) As String()
    Dim I As Long, nbItems As Long, nbColonnes As Integer
    Dim Recherche As Range, Adresse As String
    Dim strTemp As String, tablo() As String

    ReDim tablo(0)
    nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column

    'première recherche à la verticale
    '   « Columns("G") » peut être remplacé par « Cells »
    Set Recherche = Columns("G").Find(Mot, LookAt:=xlPart, MatchCase:=False)
    If Not Recherche Is Nothing Then
        Adresse = Recherche.Address 'stocke l'adresse de départ
        Do
        'Deuxième recherche à l'horizontale
            'redimensionner le tableau
            ReDim Preserve tablo(nbItems)

            'Lire la ligne en insérant le séparateur
            For I = 1 To nbColonnes
                strTemp = strTemp & Cells(Recherche.Row, I) & Séparateur
            Next

            'enlever le dernier séparateur en trop
            strTemp = Left(strTemp, Len(strTemp) - Len(Séparateur))

            'Insérer la ligne au tableau
            tablo(nbItems) = strTemp
            nbItems = nbItems + 1 ' pour le redimensionnement au prochain passage

            Set Recherche = Columns("G").FindNext(Recherche)
        Loop Until Recherche.Address = Adresse Or Recherche Is Nothing
    End If

    RechercheMot = tablo
End Function
.

MPi

Réponse 22 / 27

avyrex1926 Messages postés 360 Date d'inscription dimanche 3 décembre 2006 Statut Membre Dernière intervention 3 janvier 2012 3
28 juil. 2007 à 16:29

Donc si je comprend bien, avec se script, je peux toujours l'utiliser pour avoir les résultat de recherche dans mon ListBox1 après avec mis le mots à rechercher dans mon textbox1 et cliqué sur un bouton rechercher?

Réponse 23 / 27

cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
28 juil. 2007 à 16:58

Ben, sans tester, je remplacerais la boucle For I...Next
Et laisse tomber le tableau qui ne sert pas vraiment si c'est une Listbox à remplir...

Quelque chose comme

            'Lire la ligne en insérant le séparateur
            For I = 1 To nbColonnes
                Listbox1.AddItem Cells(Recherche.Row, I)
            Next
          'et un autre AddItem pour une ligne vide
          Listbox1.AddItem

          'Et éventuellement un AddItem avant le For I... pour insérer le titre comme tu semblais vouloir le faire

Donne-moi quelques minutes ...
MPi

Réponse 24 / 27

cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
28 juil. 2007 à 17:11

Tu peux enlever la déclaration nbItems qui ne sert plus ...

MPi

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

Posez votre question

Réponse 25 / 27

avyrex1926 Messages postés 360 Date d'inscription dimanche 3 décembre 2006 Statut Membre Dernière intervention 3 janvier 2012 3
28 juil. 2007 à 18:02

Super cette facon de faire aussi. J'aime bien.

Met je me rend compte qu'il me donne seulement le numéro de la ligne et la valeur de la celule A de la ligne.

Il faudrait qu'il me donne la valeur de la colone A à Z.

donc je devrais modifier cette partie je crois:

'Lire la ligne
            UserForm1.ListBox1.AddItem Space(8) & "LIGNE : " & Recherche.Row
            For I = 1 To nbColonnes
                UserForm1.ListBox1.AddItem Cells(Recherche.Row, I)

Réponse 26 / 27

avyrex1926 Messages postés 360 Date d'inscription dimanche 3 décembre 2006 Statut Membre Dernière intervention 3 janvier 2012 3
28 juil. 2007 à 18:17

oups, j'avais marqué :
nbColonnes = Cells.Find("*", Range(" A4 "), , , xlByColumns, xlPrevious).Column

j'ai chamgé pour :
nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column

La, ça fonctionne!

Je te redonne des nouvelles.

merci

Réponse 27 / 27

cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
28 juil. 2007 à 18:22

Ce ne serait pas supposé ...

'Cette ligne inscrit le numéro de ligne en guise d'entête de chaque section
            UserForm1.ListBox1.AddItem Space(8) & "LIGNE : " & Recherche.Row

'Ici, ça boucle de la colonne A jusqu'au nombre de colonnes utilisées sur la feuille active
'et ça ajoute la valeur de chaque cellule à la Listbox
            For I = 1 To nbColonnes
                UserForm1.ListBox1.AddItem Cells(Recherche.Row, I)

MPi

Discussions similaires

A quoi sert la fonction Set ?

Utilisation de la fonction SET

Set variable = Nothing

fonction modulo en VBA

[Excel | VBA] Macro fonction "Remplacer" avec variables

Votre réponse

Discussions similaires