Forcer un changement de ligne lors d'une recherche avec FindNext

Question

Bonjour à toutes et à tous, 
Le code suivant vise à rechercher dans une plage de cellules, les correspondances avec une chaîne de caractères saisie dans un formulaire, puis de restituer le résultat des lignes concernées.

Problème : sur une même ligne, le texte recherché peut figurer dans plusieurs cellules, en raison de la présence de tags. Si c'est le cas, le programme renvoie autant de lignes de résultat que d'occurrences trouvées sur la ligne.
L'idée consistant à forcer un changement de ligne dès qu'une correspondance est trouvée ne fonctionne pas avec le FindNext dans la boucle Do...

Merci pour votre aide.

------------------------------------------------------------------------
Exemple de ligne :
15/09/2014   Résumé	   ABCD	 BZZ   Groupe de CLUJ     Cluj	ABCD, BZZ, Cluj
Si l'on cherche "cluj" on obtient 3 lignes identiques de résultat, alors que l'on n'en a besoin que d'une.

------------------------------------------------------------------------

Le code :

Private Sub CommandButton2_Click()
'Clic sur le bouton "Critère de recherche"
'Activer feuille de données
    Sheets("BDD").Activate

On Error Resume Next

'effacer la recherche précédente
ListBox1.Clear

'Avec la recherche sur la feuille :
   With Sheets("BDD")
        Set c = .UsedRange.Find(TextBox1, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
               
        If Not c Is Nothing Then
            firstAddress = c.Address
            testLigne = c.Row
                        
            Do
                dcol = .Cells(c.Row, 256).End(xlToLeft).Column
                ' dcol = nombre de colonnes du tableau contenant des infos à extraire
                
                With ListBox1
                'Extraction des informations de la ligne, colonne par colonne
                
                    If dcol > .ColumnCount Then .ColumnCount = dcol
                    .ColumnWidths = "55;50;40;80;350;0;0;150"
                    .AddItem Sheets("BDD").Cells(c.Row, 1)
                    x = ListBox1.ListCount - 1
                    For i = 2 To dcol
                       ListBox1.List(x, i - 1) = Sheets("BDD").Cells(c.Row, i)
                    Next
                                                           
                End With
               
               
                Set c = .UsedRange.FindNext(c)

            Loop While Not c Is Nothing And c.Address <> firstAddress
        
        End If
    
    End With

End Sub

cs_MPi · Answer

Bonjour,

Plutôt que d'utiliser Find, tu pourrais utiliser 2 boucles.
Quelque chose comme ceci...
For I = premiereligne to derniereligne   For J = premierecolonne to dernierecolonne      If Instr(1, cells(i,j), textbox1) > 0 then         'inscrit la ou les données         exit for ' sort de la boucle J des colonnes, donc change de ligne      end if   nextnext

ucfoutu · Answer

Bonjour,
tu veux éviter de rester sur la même ligne ?
Bien ...
Un peu (si peu) de réflexion, alors :
ton 
firstAddress = c.Address
concerne une adresse EXACTE
Il ne te viendrait vraiment pas à l'idée d'utiliser la propriété Row en plus de la propriété Address ? Vraiment pas ?
Et tu ne verrais pas alors comment et par quoi modifier cette ligne de code :
Loop While Not c Is Nothing And c.Address <> firstAddress 
et donc : de n'ajouter à ta liste que lorsque .row est différent ?
Si vraiment pas ... tu ne seras jamais capable d'aller bien loin. Cela voudrait tout simplement dire que tu sais copier, que tu sais coller, mais ne comprends pas réellement le sens et la portée de ce que tu copies et colles.
Un peu de réflexion, je t'en prie !
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.

ucfoutu · Answer

Tiens,
je me suis amusé à traiter encore autrement, juste pour t'obliger à t'investir (car il va falloir que tu comprennes et adaptes)
Exemple de code sur une feuille contenant une listbox.
On y traite la plage A1:F8 et on ne retient que les cellules où figure au moins un "a" ===>>>
 Private Sub CommandButton1_Click()  ListBox1.ColumnCount = 6  ListBox1.Clear  For i = 1 To 8     ListBox1.AddItem ""     toto = False    For j = 1 To 6      If Cells(i, j).Value Like "*a*" Then        ListBox1.List(ListBox1.ListCount - 1, j - 1) = Cells(i, j).Value        toto = True      End If    Next    If Not toto Then ListBox1.RemoveItem ListBox1.ListCount - 1  NextEnd Sub

Interroge-toi sur :
- la raison pour laquelle j'insère systématiquement une ligne au départ (pour faire face à quel cas particulier possible ?) ?
- le rôle que tient toto dans cette affaire-là

Une autre manière/panachage, maintenant (toujours pour t'obliger à réfléchir :
ListBox1.ClearFor Each R In Range("A1:F10").Rows  Set c = R.Find("a", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)  If Not c Is Nothing Then    ListBox1.AddItem ""    ListBox1.List(ListBox1.ListCount - 1, c.Column) = c.Value    firstAddress = c.Address    Do      Set c = R.FindNext(c)      ListBox1.List(ListBox1.ListCount - 1, c.Column) = c.Value    Loop While Not c Is Nothing And c.Address <> firstAddress  End IfNext
Tu en veux d'autres ? On pourrait s'amuser à en créer des milliers, chacune personnelle (sans copiers/collers)

Allez ===>> lance-toi maintenant seul en en "inventant" une autre toi-même ===>>> fais-le en utilisant WorksheetFunction.CountIf
Oui oui  .... (bien évidemment ... et entre autres) ... si si ...



________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.

Forcer un changement de ligne lors d'une recherche avec FindNext

3 réponses

Votre réponse

Discussions similaires