Problème avec les doublons

[Lone-wolf]

Bonsoir le Forum,

dans mon ancien fichier, j'avais inscrit les noms et prénoms dans la même colonne. Par la suite, j'ai ajouté la colonne des Prénoms, pour avoir Noms et Prénoms dans 2 colonnes. Ceci pour pouvoir faire une recherche par nom et ville, et ensuite afficher dans la feuille principale toutes les adresses correspondant au nom qui serait dans la même ville, comme on le fais sur local.ch ou autre (pages blanches, pages jaunes).

Le problème, comme il y a des noms en doublon, le code n'est plus fonctionnel. J'ai fait une recherche sur le Forum, et j'ai vu la fonction Application.Union, mais je n'arrive pas à l'adapter.

La macro au final devrait avoir 3 critères:

recherche nom, prénom et ville
recherche nom par ville
recherche nom dans tout le pays.

Merci d'avance.

 

[pedrag31]

Re : Problème avec les doublons

Bonjour LoneWolf, Bonjour le forum,

Sympa ton petit projet VBA! 😎

Ci-joint, une proposition de recherche multicritères avec, un peu comme Google (héhé), un seul champ de saisie où l'on peut rentrer au choix, un nom, un prénom, une ville, une rue, etc... On peut également faire des recherches partielles comme "dup" pour trouver "Dupont" ou encore "palm" pour trouver "Palmerex".

Les résultats doublons sont affichés dans un USF avec ListBox puis, lors de la sélection d'un nom, on fait disparaitre l'USF et on appelle la Sub Map pour mettre à jour ta carte.

En espérant que ça réponde à ta question...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cel As Range, lig%, plage$
If [E5] = "" Then [H5, D9:D13, C8, C13] = "": [E5].Activate: _
ActiveSheet.Shapes("pointeur").Visible = False: ActiveSheet.Shapes("attention").Visible = False: Exit Sub
    
      If [E5] <> "" Then
        lig = Sheets(2).UsedRange.Rows.Count
        If lig < 2 Then: Exit Sub: [E5].Select
        
        i = 0
        With Sheets(2).Range("A2:G" & lig)
            Set cel = .Find("*" & Range("E5").Value & "*", LookIn:=xlValues, LookAt:=xlWhole)
            If Not cel Is Nothing Then
                firstAddress = cel.Address
                Do
                ReDim Preserve Tablo(6, i)
                    Tablo(0, i) = Sheets(2).Range("A" & cel.Row).Value
                    Tablo(1, i) = Sheets(2).Range("B" & cel.Row).Value
                    Tablo(2, i) = Sheets(2).Range("C" & cel.Row).Value
                    Tablo(3, i) = Sheets(2).Range("D" & cel.Row).Value
                    Tablo(4, i) = Sheets(2).Range("E" & cel.Row).Value
                    Tablo(5, i) = Sheets(2).Range("F" & cel.Row).Value
                    Tablo(6, i) = Sheets(2).Range("G" & cel.Row).Value
                    ActiveSheet.Shapes("pointeur").Visible = True
                    i = i + 1
                Set cel = .FindNext(cel)
                Loop While Not cel Is Nothing And cel.Address <> firstAddress
                UserForm1.Show
                Else
        [C8].Value = "Désolé, aucun résultat trouvé."
         ActiveSheet.Shapes("attention").Visible = True
        Exit Sub
            End If
        End With
        End If

End Sub
'--------------------------------------------------------------------------
Private Sub UserForm_Initialize()

With ListBox1
    .Clear
    .ColumnCount = 6
    .ColumnWidths = "50;50;100;20;50;50"
    .Column = Tablo
End With

End Sub
'--------------------------------------------------------------------------
Private Sub ListBox1_Click()
If ListBox1.ListIndex <> -1 Then
    Worksheets("Recherche").[D9].Value = ListBox1.List(ListBox1.ListIndex, 0) & " " & ListBox1.List(ListBox1.ListIndex, 1)
    Worksheets("Recherche").[D10].Value = ListBox1.List(ListBox1.ListIndex, 2)
    Worksheets("Recherche").[D11].Value = ListBox1.List(ListBox1.ListIndex, 3) & " " & ListBox1.List(ListBox1.ListIndex, 4)
    Worksheets("Recherche").[D13].Value = ListBox1.List(ListBox1.ListIndex, 5)
    Worksheets("Recherche").[C13].Value = ListBox1.List(ListBox1.ListIndex, 6)
End If
Unload Me
Erase Tablo
Call map
End Sub

Bonne journée 🙂

 

[Lone-wolf]

Re : Problème avec les doublons

Bonsoir pedrag31,

désolé de répondre aussi tard, je ne pensais pas qu'on allais répondre au message.
Merci infiniment pour l'intérêt que tu as porté à mon fichier et du travail que tu as fait.

Celui-ci est intéressant, mais j'aimerais éviter de passer par un formulaire. Comme je l'ai dis dans mon post précédent, c'est de réussir à faire la même chose comme sur local.ch.

Amicalement

A+ 😎 Lone-wolf

 

[Lone-wolf]

Re : Problème avec les doublons

Re pedrag31,

ce que j'essaie de faire en image.

​

A+ 😎