Suppression des doublons et récupération données cellules

UltrAzimut · 21 Février 2010

Bonsoir,
Sur une feuille ("Feuil1") j'ai une liste de noms sur plusieurs colonnes. J'ai donc défini une plage "NOM".
Sur une feuille appelé "Feuil2", j'ai un bouton et je souhaiterai que lorsque je clique dessus, la liste de noms s'affiche dans la colonne A à partir de la ligne 6.

Pour ce faire, ma macro est la suivante :

Code:

Sub RecupNom()
Dim i As Integer
i = 1
With Sheets("Feuil1")
For Each C In .Range("NOM")
     If Not IsEmpty(C) Then
     With Sheets("Feuil2")
         .Range("A" & 5 + i) = [C]
         .Range("B" & 5 + i) = C.Offset(0, 1)
     End With
     i = i + 1
     End If
Next
End With
End Sub

Maintenant, cette liste de noms comporte des doublons que je souhaiterai supprimer lorsque je génère la liste.

Comment puis je procéder ?

Merci

_Thierry · 21 Février 2010

Re : Suppression des doublons et récupération données cellules

Bonsoir UltrAzimut, le Forum

La méthode d'utilisation d'un Object Collection en Forçant une Erreur si il y a Duplication de sa Key permet très simplement d'éradiquer des Doublons.

Voici cette méthode appliquée à ton Code :

Code:

Option Explicit
Sub RecupNom()
Dim i As Integer, x As Integer
Dim ColBase As New Collection
Dim TabPlage As Variant, Container As Variant
Dim Item As Variant
 
    With Sheets("Feuil1")
        TabPlage = .Range("MyName")
    End With
    
 
On Error Resume Next
    For i = 1 To UBound(TabPlage)
        If Not IsEmpty(TabPlage(i, 1)) Then
            ColBase.Add CStr(Trim(TabPlage(i, 1))) & "#" & CStr(Trim(TabPlage(i, 2))), CStr(Trim(TabPlage(i, 1))) & "#" & CStr(Trim(TabPlage(i, 2)))
        End If
    Next
On Error GoTo 0
    For Each Item In ColBase
      Container = Split(Item, "#")
      x = x + 1
        
             With Sheets("Feuil2")
                 .Range("A" & 5 + x) = Container(0)
                 .Range("B" & 5 + x) = Container(1)
             End With
    Next
 
 
End Sub

NB Cet Algo détectera les doublons d'info sur les Deux Colonnes (Exemple Colonne "A" = Nom, Colonne "B" = Adresse) par conséquent Même Nom, Même Adresse sera considéré comme doublon (et ignoré) par contre même Nom, adresse différente sera accepté.

Cordialement

@+Thierry

jeanpierre · 21 Février 2010

Re : Suppression des doublons et récupération données cellules

Bonsoir le fil, _Thierry,

_Thierry que cela fait plaisir à te revoir.... Très apprécié car il y avait un très gros manque.

Bonne soirée.

Jean-Pierre

UltrAzimut · 22 Février 2010

Re : Suppression des doublons et récupération données cellules

Bonsoir le forum,

Merci Thierry pour tes explications et la modification de mon code. Néanmoins, le résultat attendu est correcte lorsque la plage de cellule est continue, lorsque celle ci est discontinu sur plusieurs colonnes, seule la première colonne est traité.
Comme un ex est plus parlant, je joins un fichier avec un classeur composé de 4 feuilles. Le bouton valider de la feuille 2 traite les infos de la feuille 1 dont la plage de cellule "NOMS" est continue. Sur la feuille 4, le bouton traite les infos de la feuille 3, la plage de cellules discontinue est nommée "NOMSBIS". Le résultat n'est alors pas correcte puisque tous les noms concernés ne sont pas récupérés.
D'apres mes recherches, l'utilisation de "application.union" pourrait etre une solution mais j'avoue ne pas avoir obtenu le bon résultat.

ex :

Code:

 With Sheets("XXXXX")
        TabPlage = .Range(.Cells(x, x), .Cells(x, x))
        TabPlage = Application.Union(TabPlage, .Cells(x,x), Cells(x, x).Resize(25))
        TabPlage = Application.Union(TabPlage, .Cells(x, x), Cells(x, x).Resize(x))
        TabPlage = Application.Union(TabPlage, .Cells(x, x), Cells(x, x).Resize(x))
    End With

Merci pour l'aide apportée

UltrAzimut · 25 Février 2010

Re : Suppression des doublons et récupération données cellules

Bonsoir le forum,

Lorsque les plages sont discontinues, pour arriver au résultat que je souhaitais, il m'a fallu modifier le code comme ceci :

Code:

Option Explicit
Sub RecupNom()
Dim i As Integer, x As Integer
Dim ColBase As New Collection
Dim TabPlage, TabPlage2, TabPlage3 As Variant, Container As Variant
Dim Item As Variant
 
    With Sheets("Feuil1")
        TabPlage = .Range("Plage1") //
        TabPlage2 = .Range("Plage2") // on suppose 3 plages 
        TabPlage3 = .Range("Plage3") //
    End With
    
 
On Error Resume Next
    For i = 1 To UBound(TabPlage)
        If Not IsEmpty(TabPlage(i, 1)) Then
            ColBase.Add CStr(Trim(TabPlage(i, 1))) & "#" & CStr(Trim(TabPlage(i, 2))), CStr(Trim(TabPlage(i, 1))) & "#" & CStr(Trim(TabPlage(i, 2)))
        End If
    Next
On Error Resume Next
    For i = 1 To UBound(TabPlage2)
        If Not IsEmpty(TabPlage2(i, 1)) Then
            ColBase.Add CStr(Trim(TabPlage2(i, 1))) & "#" & CStr(Trim(TabPlage2(i, 2))), CStr(Trim(TabPlage2(i, 1))) & "#" & CStr(Trim(TabPlage2(i, 2)))
        End If
    Next
On Error Resume Next
    For i = 1 To UBound(TabPlage3)
        If Not IsEmpty(TabPlage3(i, 1)) Then
            ColBase.Add CStr(Trim(TabPlage3(i, 1))) & "#" & CStr(Trim(TabPlage3(i, 2))), CStr(Trim(TabPlage3(i, 1))) & "#" & CStr(Trim(TabPlage3(i, 2)))
        End If
    Next
On Error GoTo 0
    For Each Item In ColBase
      Container = Split(Item, "#")
      x = x + 1
        
             With Sheets("Feuil2")
                 .Range("A" & 5 + x) = Container(0)
                 .Range("B" & 5 + x) = Container(1)
             End With
    Next
 
 
End Sub

Merci Thierry pour le code de départ

@ bientôt

Suppression des doublons et récupération données cellules

UltrAzimut

XLDnaute Nouveau

_Thierry

XLDnaute Barbatruc

jeanpierre

Nous a quitté

UltrAzimut

XLDnaute Nouveau

Pièces jointes

UltrAzimut

XLDnaute Nouveau

Discussions similaires

Suppression des doublons et récupération données cellules

UltrAzimut

XLDnaute Nouveau

_Thierry

XLDnaute Barbatruc

jeanpierre

Nous a quitté

UltrAzimut

XLDnaute Nouveau

Pièces jointes

UltrAzimut

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency