Find avec retour multiple

Le 30/01/2017 à 11:27

Bonjour à toutes et à tous,

Ma macro fonctionne mais elle ne me retourne pas totalement ce que je désire.

J'aimerai qu'en fonction de la valeur issue du combobox, la macro trouve toutes les valeurs correspondantes à celle-ci.

Pour le moment, ma macro me trouve la première valeur correspondante.

Est-ce que quelqu'un aurait-il une idée de ce qu'il faut que je fasse?

Merci d'avance,

Cordialement,

Marion

Private Sub CommandButton1_Click()

'déclaration des variables :
Dim Trouve  As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String

'********* à adapter ***********
'affectation de valeurs aux variables :
    'on cherche le mot "Trouve"
''REMPLACER''Valeur_Cherchee = "Trouve"
Valeur_Cherchee = Country.ComboBox1.Value
    'dans la première colonne de la feuille active
''REMPLACER''Set PlageDeRecherche = ActiveSheet.Columns(1)
Set PlageDeRecherche = Sheets("DATA").Range("D:D")
'*******************************

'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)

'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
'Else
    'ici, traitement pour le cas où la valeur est trouvée
    'AdresseTrouvee = Trouve.Row

    Do

            Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
            Loop Until Trouve Is Nothing Or AdresseTrouvee = Trouve.Row
End If
 Rows(AdresseTrouvee).Select
 Selection.EntireRow.Hidden = False
    Unload Country

'AdresseTrouvee.Columns.Select
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
End Sub
69exchange.xlsm (38.62 Ko)
Le 30/01/2017 à 16:05

Bonjour,

Une piste :

Private Sub CommandButton1_Click()

    Dim Tbl() As Long
    Dim PlageDeRecherche As Range
    Dim Trouve As Range
    Dim I As Long
    Dim Adr As String

    If ComboBox1.Value = "" Then Exit Sub

    With Worksheets("DATA"): Set PlageDeRecherche = .Range(.Cells(3, 4), .Cells(.Rows.Count, 4).End(xlUp)): End With

    Set Trouve = PlageDeRecherche.Find(ComboBox1.Text, , xlValues, xlWhole)

    If Not Trouve Is Nothing Then

        Adr = Trouve.Address

        Do

            I = I + 1
            ReDim Preserve Tbl(I)
            Tbl(I) = Trouve.Row 'stocke le numéro de ligne

            Set Trouve = PlageDeRecherche.FindNext(Trouve)

        Loop While Trouve.Address <> Adr

        'Attention, si la ligne est cachée, la valeur ne sera pas trouvée !
        For I = 1 To UBound(Tbl)

            Worksheets("DATA").Rows(Tbl(I)).EntireRow.Hidden = False

        Next I

    Else

        MsgBox "Le pays '" & ComboBox1.Text & "' n'existe pas dans la feuille !"

    End If

End Sub
Le 30/01/2017 à 16:49

Merci de vouloir m'aider

Malheureusement le code ne fonctionne pas

Dans tout les cas, c'est gentil à vous de prendre de votre temps pour moi !

Le 30/01/2017 à 22:25

Bonsoir,

Déplacer les boutons en ligne 1 à droite du libellé (Exchange with the countries) et essayer ce code :

Private Sub CommandButton1_Click()

'déclaration des variables :
Dim Trouve As Range, Trouve1 As Range, PlageDeRecherche As Range, LignesTrouvees As Range, ligne As Range
Dim Valeur_Cherchee As String
Dim i As Byte, x As Byte
'********* à adapter ***********
'affectation de valeurs aux variables :
    'on cherche le mot "Trouve"
''REMPLACER''Valeur_Cherchee = "Trouve"
Valeur_Cherchee = Country.ComboBox1.Value
    'dans la première colonne de la feuille active
''REMPLACER''Set PlageDeRecherche = ActiveSheet.Columns(1)
Set PlageDeRecherche = Sheets("DATA").Range("D:D")
'*******************************

'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)

'traitement de l'erreur possible : Si on ne trouve rien :
If Not Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur est trouvée
    Set Trouve1 = Trouve
    Do
        If LignesTrouvees Is Nothing Then Set LignesTrouvees = Trouve.EntireRow _
        Else Set LignesTrouvees = Union(LignesTrouvees, Trouve.EntireRow)
        Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
    Loop Until Trouve.Address = Trouve1.Address
Else
    'ici, traitement pour le cas où la valeur n'est pas trouvée
    'LigneTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
End If

For Each ligne In Sheets("DATA").UsedRange.Rows
    If ligne.Row > 2 Then
        If Intersect(ligne, LignesTrouvees) Is Nothing Then ligne.Hidden = True _
        Else ligne.Hidden = False
    End If
Next

Unload Country

'LigneTrouvee.Columns.Select
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
End Sub
Le 31/01/2017 à 06:41

Bonjour,

Si tu cherches une valeur dans des lignes cachées, la méthode Find() ne la trouvera pas ! Les lignes ne doivent pas être" Hidden=True" !

Si tu as des lignes cachées dans ta plage, il te faut boucler sur celle-ci pour faire la recherche. En mettant ta plage dans un tableau, la recherche sera plus rapide.

Le 31/01/2017 à 09:20

Bonjour,

Merci beaucoup à vous j'avance un peu plus chaque jour, c'est presque ça ! Je pense que la solution est proche

Je vais regarder en détail ce code !

J'ai modifié le code, je vais faire juste une selection des lignes dont la valeur correspond à la valeur du comobobox.

Malheureusement quand il y'a un doublon, ça ne me sélectionne qu'une des deux valeurs mais pas les deux. Comment faire pour selectionner deux lignes ?

Private Sub CommandButton1_Click()

'déclaration des variables :
Dim Trouve As Range, Trouve1 As Range, PlageDeRecherche As Range, LignesTrouvees As Range, ligne As Range
Dim Valeur_Cherchee As String
Dim i As Integer, x As Integer
ActiveWindow.SplitColumn = 1
ActiveWindow.FreezePanes = True
i = 3
x = Sheets("DATA").Range("G65536").End(xlUp).Row
'********* à adapter ***********
'affectation de valeurs aux variables :
   'on cherche le mot "Trouve"
''REMPLACER''Valeur_Cherchee = "Trouve"
Valeur_Cherchee = Country.ComboBox1.Value
    'dans la première colonne de la feuille active
''REMPLACER''Set PlageDeRecherche = ActiveSheet.Columns(1)
Set PlageDeRecherche = Sheets("DATA").Range("D:D")
'*******************************

'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)

'traitement de l'erreur possible : Si on ne trouve rien :
If Not Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur est trouvée
   Set Trouve1 = Trouve
    Do
        If LignesTrouvees Is Nothing Then Set LignesTrouvees = Trouve.EntireRow _
        Else Set LignesTrouvees = Union(LignesTrouvees, Trouve.EntireRow)
        Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
    Loop Until Trouve.Address = Trouve1.Address
Else
    'ici, traitement pour le cas où la valeur n'est pas trouvée
   'LigneTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
End If

For Each ligne In Sheets("DATA").UsedRange.Rows
    If ligne.Row > 2 Then
        If Intersect(ligne, LignesTrouvees) Is Nothing Then _
        Else ligne.Select
    End If
Next

Unload Country

'LigneTrouvee.Columns.Select
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
End Sub
Le 31/01/2017 à 20:12

Bonsoir,

Il suffit alors tout simplement d'appliquer le "select" à la plage "LignesTrouvees" et le reste du code est alors inutile.

LignesTrouvees.Select
'With Sheets("DATA").UsedRange
'    For Each ligne In .Rows
'        If ligne.Row > .Row Then
'            If Intersect(ligne, LignesTrouvees) Is Nothing Then ligne.Hidden = True _
'            Else ligne.Hidden = False
'        End If
'   Next
'End With
Le 01/02/2017 à 09:07

C'est parfait merci beaucoup

Je pense que pour le moment je vais en arreter là car je n'ai pas le niveau nécéssaire pour pousser plus loin cette macro !

Mille mercis

Rechercher des sujets similaires à "find retour multiple"