Userform de recherche [Résolu]

Signaler
Messages postés
46
Date d'inscription
vendredi 3 août 2007
Statut
Membre
Dernière intervention
18 décembre 2007
-
Messages postés
46
Date d'inscription
vendredi 3 août 2007
Statut
Membre
Dernière intervention
18 décembre 2007
-
Bonjour,
J'ai un problème sous VBA avec un userform de recherche, j'ai trouvé plusieurs codes mais je n'arrive pas à les appliquer à mon cas. En fait j'ai un Userform avec une textbox nommée "Recherche", et deux boutons, un "valider" et l'autre "annuler".
Ce que souhaiterai c'est que lorsque l'utilisateur entre un mot et que ce mot est dans la feuille analyse qu'il me copie les colonnes A à P des lignes contenant ce mot sur la feuille "résultats de la recherche".

Voici une macro que j'ai trouvé et qui marche bien et j'aimerai l'appliquer à mon fichier. Merci.

Option Explicit



Private Sub CommandButton1_Click()
'commandbutton1 = bouton annuler
    Unload Me
End Sub




Private Sub AfficheListe_Click()
'afficheliste = bouton chercher
    
Dim WS As Variant
    Dim Plage As Range
    Dim Cherche, Adresse As String
    Dim Ligne, Arrivee As Variant
    Dim C As Object
    'efface la plage nommée "Zone"
    Feuil2.Range("Zone").Clear
    Cherche = TextBox1
    Ligne = 5
    If Cherche = "" Then Exit Sub
   
    'stockage de la donnée cherchée en F2
    Range("F2").Value = Cherche




    'plage de donnée
    Set Plage = Worksheets("donnée").Range("a2:J5000")
    With Plage
        'cherche c'est ce qu'on a mis en textbox 1
        Set C = .Find(Cherche)
        If Not C Is Nothing Then
            Adresse = C.Address
            Do
                Arrivee = Mid(C.Address, 3)
                Worksheets("donnée").Range("a" & Arrivee & ":az" & Arrivee).Copy Feuil2.Range("B" & Ligne)
                Ligne = Feuil2.Range("" & "B" & "65536").End(xlUp).Row + 1
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> Adresse
        End If
    End With
    'ici on refait une boucle sur feuille "Résultats"
    'pour traiter la couleur de la cellule (rouge/gras)
    Set Plage = Feuil2.Range("a4:az5000")
    With Plage
        Set C = .Find(Cherche)
        If Not C Is Nothing Then
            Adresse = C.Address
            Do
                Arrivee = Mid(C.Address, 3)
                With Feuil2.Range(C.Address)
                    .Font.Bold = True
                    .Font.ColorIndex = 3
                End With
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> Adresse
        End If
    End With
    Unload Me
End Sub

Merci et Bonne journée.

2 réponses

Messages postés
60
Date d'inscription
vendredi 26 octobre 2007
Statut
Membre
Dernière intervention
30 mars 2010

Bonsoir à tous
Bonsoir Arnaud

Si j'ai bien compris ce que tu recherches, essaie ceci :

Sub recherche()
Dim c
Dim i As Integer
Dim ligne As Integer
Dim maligne As Integer

texte = "oui"   'textbox1.text ou autre
ligne = Worksheets("Feuil2").Range("A65536").End(xlUp).Row     'modifier le nom de la feuille qui reçoit. On admet que cellule de la colonne A est toujours remplie
With Worksheets("Feuil1").Range("A1:Z5000")     'modifier le nom de la feuille origine
    Set c = .Find(texte, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            i = i + 1
            maligne = c.Row
            Worksheets("Feuil2").Range("A" & i + ligne & ":z" & i + ligne).Value = Worksheets("Feuil1").Range("A" & maligne & ":z" & maligne).Value     'modifier le nom des lfeuilles
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End Sub

A mettre pour le bouton "valider"

Frédéric
Messages postés
46
Date d'inscription
vendredi 3 août 2007
Statut
Membre
Dernière intervention
18 décembre 2007

Ok, merci beaucoup je l'ai appliqué à mon cas et çà marche. Bonne journée.