Recherche multiple

Bonjour,

Je voudrais modifier un formulaire pour me faciliter la vie.

sur la macro ci joint la recherche se fait sur la cellule A3 de l'onglet "recherche"

Je cherche a faire en sorte que la recherches puisse se faire a partir de la colonne A

ligne correspondant : RechNom = Sheets("Recherche").[A3] 'adresse du nom que l'on recherche

macro complète:

Sub Btnpc_Clic()

Dim RechNom As String, firstAddress As String

Dim i As Byte, derlign As Long, derLignTemp As Long

Dim c As Range

RechNom = Sheets("Recherche").[A3] 'adresse du nom que l'on recherche

'If RechNom = "" Then MsgBox "Pas de nom saisi", vbInformation: Exit Sub

derlign = Sheets("Recherche").[b65536].End(xlUp).Row

If derlign > 5 Then Range("b3:m" & derlign).ClearContents 'on efface la liste des résultats avant de commencer la recherche

For i = 2 To Sheets.Count 'on boucle sur toutes les feuilles à partir de la 2è

derlign = Sheets(i).Range("A65536").End(xlUp).Row

With Sheets(i).Range("g4:g" & derlign)

Set c = .Find(RechNom, LookIn:=xlValues, Lookat:=xlWhole) 'on effectue la recherche avec la méthode Find

If Not c Is Nothing Then

firstAddress = c.Address

Do

With Sheets("Recherche")

derLignTemp = .Range("g65536").End(xlUp).Row + 1

'on inscrit les résultats de la recherche dans la feuille Recherche

.Range("B" & derLignTemp) = c.Offset(, -6)

.Range("C" & derLignTemp) = c.Offset(, -5)

.Range("D" & derLignTemp) = c.Offset(, -4)

.Range("E" & derLignTemp) = c.Offset(, -3)

.Range("F" & derLignTemp) = c.Offset(, -2)

.Range("G" & derLignTemp) = c.Offset(, -1)

.Range("H" & derLignTemp) = c.Value

.Range("I" & derLignTemp) = c.Offset(, 1)

.Range("J" & derLignTemp) = c.Offset(, 2)

.Range("K" & derLignTemp) = c.Offset(, 3)

.Range("L" & derLignTemp) = c.Offset(, 4)

.Range("M" & derLignTemp) = c.Offset(, 5)

End With

Set c = .FindNext(c)

Loop While Not c Is Nothing And c.Address <> firstAddress

End If

End With

Next i

End Sub

Par avance Merci

Thierry

Bonjour,

Merci de joindre ton fichier pour tester la macro.

bonjour

ci joint mon fichier

Re,

J'ai modifié ton code de recherche par Code Postal pour effectuer multi-recherches. A tester et à adpapter pour la recherche par Nom. J'ai tout simplement ajouté un boucle pour la multi-recherches dans la plage A3:Axxx.

Voici ton code modifié :

Sub Btnpc_Clic()
    Dim DonneeRech As String, firstAddress As String
    Dim i As Byte, j as Byte, derLignRech As Long, derLignOnglet As Long, derLignDonnee as Long
    Dim c As Range
    derLignRech = Sheets("Recherche").Range("A" & Rows.Count).End(xlUp).Row
    If derLignRech = 1 Then
        MsgBox "Aucune donnée à rechercher"
        Exit Sub
    End If
    derLignDonnee = Sheets("Recherche").Range("B" & Rows.Count).End(xlUp).Row
    If derLignDonnee > 2 Then Range("B3:M" & derLignDonnee).ClearContents 'on efface la liste des résultats avant de commencer la recherche
    For j = 3 To derLignRech
        DonneeRech = Sheets("Recherche").Range("A" & j) 'la donnée que l'on recherche
        derLignRech = Sheets("Recherche").Range("B" & Rows.Count).End(xlUp).Row
        For i = 2 To Sheets.Count 'on boucle sur toutes les feuilles à partir de la 2è
            derLignOnglet = Sheets(i).Range("A" & Rows.Count).End(xlUp).Row
            With Sheets(i).Range("G2:G" & derLignOnglet)
                Set c = .Find(DonneeRech, LookIn:=xlValues, Lookat:=xlWhole) 'on effectue la recherche avec la méthode Find
                If Not c Is Nothing Then
                    firstAddress = c.Address
                    Do
                        With Sheets("Recherche")
                            derLignRech = .Range("G" & Rows.Count).End(xlUp).Row + 1
                            'on inscrit les résultats de la recherche dans la feuille Recherche
                            .Range("B" & derLignRech) = c.Offset(, -6)
                            .Range("C" & derLignRech) = c.Offset(, -5)
                            .Range("D" & derLignRech) = c.Offset(, -4)
                            .Range("E" & derLignRech) = c.Offset(, -3)
                            .Range("F" & derLignRech) = c.Offset(, -2)
                            .Range("G" & derLignRech) = c.Offset(, -1)
                            .Range("H" & derLignRech) = c.Value
                            .Range("I" & derLignRech) = c.Offset(, 1)
                            .Range("J" & derLignRech) = c.Offset(, 2)
                            .Range("K" & derLignRech) = c.Offset(, 3)
                            .Range("L" & derLignRech) = c.Offset(, 4)
                            .Range("M" & derLignRech) = c.Offset(, 5)
                        End With
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> firstAddress
                End If
            End With
        Next i
    Next j
End Sub

Bonjour,

Superbe merci raja, c’est ce que je recherché

Pour l’instant, la recherche et longue s'il y a une amélioration à faire, elle est sur un recherche plus rapide

cdt

thierry

Re,

Tu cherches combien d'enregistrements en même temps ? Car, chez-moi la recherche est très rapide (en milli-secondes) avec quelques données à rechercher.

Je te joins ton fichier avec codes modifiés. Teste-le. A moins que ce n'est pas le fichier sur lequel tu testes la macro.

Je cherche 150 à 200 enregistrements

je viens de retenter une recherche et la recherche et rapide

Tout et OK MERCI BEAUCOUP

Ci par erreur, j'écris deux fois le même code postal, il me double le résultat

Il y a-t-il une solution ?

Thierry

Re,

Avec le traitement de doublons + quelques modifications de présentation.

BONJOUR,

Merci ça marche nickel

je cherche a remplacé des espaces par des tirets et l’inverse aussi

a tu une solution

merci

thierry