macro de recherche dans les onglets

dubdub87

XLDnaute Nouveau
bonjours chers amis

je viens vers vous car dans mon projet j'ai créer un macro pour recherché dans les onglets mais la formule que j'ai mis ne fonctionne pas.

par contre le souci et que j'ai essayer de compresser le fichier pour vous le montrer mes meme compresser en winzip il fait 1.16Mo en winrar 1.14Mo et non compresser 1.20Mo j'ai fait sous winrar

dslé

merci d'avance
 

dubdub87

XLDnaute Nouveau
Re : macro de recherche dans les onglets

rebonjours chers amis

je reviens vers vous avec un exemple de mon projet j'ai créer un macro pour recherché dans les onglets (huiles aquarelle gouaches) mais la formule que j'ai mis ne fonctionne pas.
comment faire svp

merci d'avances
 

Pièces jointes

  • EXEMPLE.xlsx
    12.1 KB · Affichages: 46
  • EXEMPLE.xlsx
    12.1 KB · Affichages: 51
  • EXEMPLE.xlsx
    12.1 KB · Affichages: 55

Robert

XLDnaute Barbatruc
Repose en paix
Re : macro de recherche dans les onglets

Bonsoir Dubdub, bonsoir Gelinotte, bonsoir le forum,

Une proposition en pièce jointe. La recherche s'affine au fur et à mesure que tu tape le texte dans la TextBox1. Clique ensuite dans l'élément de la ListBox1 pour l'atteindre et fermer l'UserForm.
Le code :

Code:
Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm
Me.ListBox1.ColumnCount = 3 'définit le nombre de colonne de la LisBox1
Me.ListBox1.ColumnWidths = "60;20" 'définit la taille des deux premières colonnes de la LisBox1
End Sub


Private Sub TextBox1_Change() 'au changement dans la TextBox1
Dim o As Object 'déclare la variable o (Onglet)
Dim r As Range 'déclare la varaible r (Recherche)
Dim pa As String 'déclare la variable pa (Première adresse)

Me.ListBox1.Clear 'vide la ListBox1
If Me.TextBox1.Value = "" Then Exit Sub 'si la TextBox1 est effacée, sort de la procédure
For Each o In Sheets 'boucle sur tous les onglets du classeur
    pa = "" 'réinitialise la variable pa
    If Not o.Name = "accueil" Then 'condition 1 : si l'onglet ne se nomme pas "accueil"
        'définit la recherche r (recherche dans l'onglet les cellules contenant la valeur dans la TextBox1)
        Set r = o.Cells.Find(Me.TextBox1.Value, , xlValues, xlPart)
        If Not r Is Nothing Then 'condition 2 : si il existe au moins une occurrence trouvée
            pa = r.Address 'définit l'adresse pa de la première occurrence
            Do 'exécute
                With Me.ListBox1 'prend en compte la ListBox1
                    .AddItem o.Name 'ajoute le nom de l'onglet
                    .Column(1, .ListCount - 1) = r.Address(0, 0) 'ajoute l'adresse de la cellule trouvée
                    .Column(2, .ListCount - 1) = r.Value 'ajoute la valeur de la cellule trouvée
                End With 'fin de la prise en compte de la ListBox1
                Set r = o.Cells.FindNext(r) 're'definit la recherceh r (occurrence suivante)
            Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs qu'en pa
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next o 'prochain onglet de la boucle
End Sub


Private Sub ListBox1_Click() 'au clic dans la ListBox1
With Me.ListBox1 'prend en compte la ListBox1
    Sheets(.Column(0, .ListIndex)).Activate 'active l'onglet de lélément cliqué
    ActiveSheet.Range(.Column(1, .ListIndex)).Select 'active la cellule de lélément cliqué
End With 'fin de la prise en compte de la ListBox1
Unload Me 'vide et ferme l'UserForm
End Sub
Le fichier :
 

Pièces jointes

  • Dubdub_v01.xls
    60 KB · Affichages: 48

Discussions similaires

Statistiques des forums

Discussions
312 490
Messages
2 088 881
Membres
103 981
dernier inscrit
vinsalcatraz