IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Améliorer une fonction recherche VBA


Sujet :

Macros et VBA Excel

  1. #1
    Membre confirmé
    Homme Profil pro
    Inscrit en
    Avril 2011
    Messages
    123
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Avril 2011
    Messages : 123
    Par défaut Améliorer une fonction recherche VBA
    Bonjour à tous,

    J'espère que des pro du VBA m'aideront à résoudre mon problème ...

    Mon soucis est que j'ai récupéré un code de recherche de nom (très efficace) mais je l'ai modifié plusieurs fois pour qu'il prenne en compte les prénoms et les noms, mais aucun résultat...

    Mon objectif : est que lorsque je tape un nom qui possède plusieurs occurrences, il m'affiche le nom et prénom de chaque occurrence... Je vous laisse voir le fichier peut-être que vous comprendrez mieux comme ça ...

    Merci par avance pour votre aide !
    Fichiers attachés Fichiers attachés

  2. #2
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    J'ai un tout petit modifié ton code et ajouté la possibilité de récupérer aussi les prénoms
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    Private Sub TextBox1_Change()
    Dim Recherche As String, Adresse As String, Res As String
    Dim MaRech As Object
    Dim Plage As Range, c As Range
    Dim Ligne As Long
     
    ListBox1.Clear
    Recherche = TextBox1.Value
    If Recherche = "" Then Recherche = "*"
    With Worksheets("BASE")
        Ligne = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set Plage = .Range("B1:B" & Ligne)
    End With
     
    Set MaRech = CreateObject("Scripting.Dictionary")
    With Plage
        Set c = .Find(Recherche, , xlValues)
        If Not c Is Nothing Then
            Adresse = c.Address
            Do
                If UCase(c.Value) Like UCase(Recherche) & "*" Then
                    Res = c.Value & "    " & c.Offset(0, 1).Value
                    MaRech(Res) = Res
                End If
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adresse
            Me.ListBox1.List = MaRech.Items
            MaRech.RemoveAll
            Set MaRech = Nothing
        End If
    End With
    Set Plage = Nothing
    End Sub

  3. #3
    Membre confirmé
    Homme Profil pro
    Inscrit en
    Avril 2011
    Messages
    123
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Avril 2011
    Messages : 123
    Par défaut
    merci pour ta réponse ça fonctionne très bien !!!

    cordialement.

  4. #4
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Le code est adapté de celui que tu as proposé initialement. Donc c'est ton code, adapté.
    Ci-après, le code légèrement commenté pour ta compréhension
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    Private Sub TextBox1_Change()
    Dim Recherche As String, Adresse As String, Res As String
    Dim MaRech As Object
    Dim Plage As Range, c As Range
    Dim Ligne As Long
     
    'On vide ListBox1
    ListBox1.Clear
     
    'Dans la variable recherche on récupère le texte siaisi dans TextBox1
    Recherche = TextBox1.Value
     
    'Cette ligne est ajouté au cas où si on efface TextBox1, on récupère dans la variable Recherche le joker * (qui signifie n'importe quel texte
    If Recherche = "" Then Recherche = "*"
     
    'Ici c'est pour instancier la variable objet Plage à notre plage de recherche
    With Worksheets("BASE")
        Ligne = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set Plage = .Range("B1:B" & Ligne)
    End With
     
    'on crée un dictionaire (pour éviter les doublons)
    Set MaRech = CreateObject("Scripting.Dictionary")
     
    With Plage
        'on fait une boucle à l'aide de Find pour récupérer toutes les cellules de la colonne B contenant le mot contenu dans TextBox1 (variable Recherche)
        Set c = .Find(Recherche, , xlValues)
        If Not c Is Nothing Then
            Adresse = c.Address
            Do
                'Si la cellule c commence par la valeur contenue dans la vriable Recherche
                If UCase(c.Value) Like UCase(Recherche) & "*" Then
                    'Dans Res, on concatène la valeur de la colonne B et celle de la colonne C
                    Res = c.Value & "    " & c.Offset(0, 1).Value
                    'on l'ajoute au dictionnaire (en évitant les doublons)
                    MaRech(Res) = Res
                End If
                'on cherche la valeur suivante
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adresse
            'on récupère le résultat du dictionnaire
            Me.ListBox1.List = MaRech.Items
            MaRech.RemoveAll
            Set MaRech = Nothing
        End If
    End With
    Set Plage = Nothing
    End Sub

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 2
    Dernier message: 16/11/2006, 16h00
  2. Réponses: 7
    Dernier message: 31/08/2006, 10h41
  3. Intégrer une fonction recherche sur un site
    Par tomowok dans le forum Autres langages pour le Web
    Réponses: 1
    Dernier message: 12/04/2006, 20h33
  4. Créer une Fonction recherche sur Access
    Par remwideco dans le forum Access
    Réponses: 4
    Dernier message: 30/01/2006, 11h36
  5. Réponses: 3
    Dernier message: 15/11/2005, 19h50

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo