Adapter macro : enlever doublon

nat54

nat54

XLDnaute Barbatruc
Bonjour,

J'avais récupéré je-sais-plus-où une macro permettant d'enlever les doublons d'une seule colonne

Code: 
[FONT=Arial][/FONT]
[FONT=Arial]Sub ENLEVER_DOUBLONS()[/FONT]
[FONT=Arial]ListeValUniques Range[COLOR=red]("A2:A5000"),[/COLOR] Range("E1")   [/FONT][COLOR=teal][FONT=Arial]‘ on met la liste en colonne 1, la liste épurée se colle en colonne E[/FONT][/COLOR][FONT=Arial][/FONT]
[FONT=Arial]End Sub[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]Sub ListeValUniques(PlageSrc As Range, CellDest As Range)[/FONT]
[COLOR=teal][FONT=Arial]'Extrait les valeurs uniques d'une colonne et les renvoie[/FONT][/COLOR]
[COLOR=teal][FONT=Arial]'dans une autre, à partir de CellDest[/FONT][/COLOR][FONT=Arial][/FONT]
[FONT=Arial]Dim Arr1, Elt, Arr2(), Coll As New Collection[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]If PlageSrc.Columns.Count > 1 Then Exit Sub[/FONT]
[FONT=Arial]Arr1 = PlageSrc.Value[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]For Each Elt In Arr1[/FONT]
[FONT=Arial]On Error Resume Next[/FONT]
[FONT=Arial]Coll.Add Elt, CStr(Elt)[/FONT]
[FONT=Arial]If Err.Number = 0 Then[/FONT]
[FONT=Arial]ReDim Preserve Arr2(1 To Coll.Count)[/FONT]
[FONT=Arial]Arr2(Coll.Count) = Elt[/FONT]
[FONT=Arial]End If[/FONT]
[FONT=Arial]On Error GoTo 0[/FONT]
[FONT=Arial]Next[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]CellDest.Resize(Coll.Count).Value = _[/FONT]
[FONT=Arial]Application.Transpose(Arr2)[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]End Sub[/FONT]

Est-ce possible de l'adapter pour qu'elle trouve les doublons en colonne A, et supprime les lignes correspondantes ?

J'ai essayé juste en changeant ce qui est en rouge mais ca ne fonctionne pas
et j'avoue que je ne comprends pas cette macro..

MERCI d'avance
 
Trier par date Trier par votes
pierrejean

pierrejean

XLDnaute Barbatruc
Re : Adapter macro : enlever doublon

vois si cela te convient

Code: 
Sub ENLEVER_DOUBLONS()
Call ListeValUniques(Range("A2:A5000"))
End Sub
Sub ListeValUniques(PlageSrc As Range)
'Extrait les valeurs uniques d'une colonne
Dim Arr1, Elt, Arr2(), Coll As New Collection
' si la plage comporte plus d'une colonne sortir
If PlageSrc.Columns.Count > 1 Then Exit Sub
'mise en tableau de la plage de valeurs
Arr1 = PlageSrc.Value
' pour chaque element du tableau
For Each Elt In Arr1
On Error Resume Next
'mise en collection des valeurs uniques
Coll.Add Elt, CStr(Elt)
If Err.Number = 0 Then
'passage de la collection dans le tableau Arr2
ReDim Preserve Arr2(1 To Coll.Count)
Arr2(Coll.Count) = Elt
End If
On Error GoTo 0
Next
'effacement de la colone
Columns(PlageSrc.Column).ClearContents
'transfert du tableau Arr2
Cells(PlageSrc.Row, PlageSrc.Column).Resize(Coll.Count).Value = _
Application.Transpose(Arr2)
End Sub
 
Vote positif 0 Vote négatif
Gorfael

Gorfael

XLDnaute Barbatruc
Re : Adapter macro : enlever doublon

nat54 à dit:
Bonjour,

J'avais récupéré je-sais-plus-où une macro permettant d'enlever les doublons d'une seule colonne

Code: 
[FONT=Arial][/FONT]
[FONT=Arial]Sub ENLEVER_DOUBLONS()[/FONT]
[FONT=Arial]ListeValUniques Range[COLOR=red]("A2:A5000"),[/COLOR] Range("E1")   [/FONT][COLOR=teal][FONT=Arial]‘ on met la liste en colonne 1, la liste épurée se colle en colonne E[/FONT][/COLOR][FONT=Arial][/FONT]
[FONT=Arial]End Sub[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]Sub ListeValUniques(PlageSrc As Range, CellDest As Range)[/FONT]
[COLOR=teal][FONT=Arial]'Extrait les valeurs uniques d'une colonne et les renvoie[/FONT][/COLOR]
[COLOR=teal][FONT=Arial]'dans une autre, à partir de CellDest[/FONT][/COLOR][FONT=Arial][/FONT]
[FONT=Arial]Dim Arr1, Elt, Arr2(), Coll As New Collection[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]If PlageSrc.Columns.Count > 1 Then Exit Sub[/FONT]
[FONT=Arial]Arr1 = PlageSrc.Value[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]For Each Elt In Arr1[/FONT]
[FONT=Arial]On Error Resume Next[/FONT]
[FONT=Arial]Coll.Add Elt, CStr(Elt)[/FONT]
[FONT=Arial]If Err.Number = 0 Then[/FONT]
[FONT=Arial]ReDim Preserve Arr2(1 To Coll.Count)[/FONT]
[FONT=Arial]Arr2(Coll.Count) = Elt[/FONT]
[FONT=Arial]End If[/FONT]
[FONT=Arial]On Error GoTo 0[/FONT]
[FONT=Arial]Next[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]CellDest.Resize(Coll.Count).Value = _[/FONT]
[FONT=Arial]Application.Transpose(Arr2)[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]End Sub[/FONT]

Est-ce possible de l'adapter pour qu'elle trouve les doublons en colonne A, et supprime les lignes correspondantes ?

J'ai essayé juste en changeant ce qui est en rouge mais ca ne fonctionne pas
et j'avoue que je ne comprends pas cette macro..

MERCI d'avance
Cliquez pour agrandir...
Salut
J'avoue que je ne comprends pas bien le but de cette macro : ce que je crois comprendre,cest qu'on se sert d'une propriété "Sans doublons" et qu'on essaie d'ajouter une valeur : s'il y a doublon, ça déclenche une ereur, s'il n'y en a pas, on ajoute la valeur

Petite question pour ton problème :
ta colonne A est triée sur A (ou peut l'être par la macro) ou elle reste en l'état ?
2 solutions :
Code: 
Sub Doub_Tri()
Dim X As Long

'tri sur A
    Columns("A:D").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

For X = [A65536].End(xlUp).Row To 2 Step -1
    If Range("A" & X) = Range("A" & X - 1) Then Rows(X).Delete
Next X
End Sub
on trie les valeurs en fonction de A
si en A ligne= ligne-1, on supprime ligne
Code: 
Sub Doub_Dir()
Dim X As Long
Dim Y As Long
Dim Flg_V As Boolean
For X = [A65536].End(xlUp).Row To 2 Step -1
    For Y = X - 1 To 1 Step -1
        If Range("A" & X) = Range("A" & Y) Then
            Flg_V = True
            Exit For
        End If
    Next Y
    If Flg_V Then
        Flg_V = False
        Rows(X).Delete
    End If
Next X
End Sub
la même sans tri
en A, si ligne (X) = ligne (Y) il y a doublon donc on positionne une valeur d'alerte à vrai et on sort de la boucle Y
en sortie de boucle Y, on teste la valeur d'alerte
si elle est vrai, on la remet à faux et on supprime la ligne

A+

PS "Celui qui croit constamment, réussit forcément" (A.GIROD)
je crois toujours que je vais gagner au loto, mais faudrait que je pense à acheter un ticket non ? :D
 
Dernière édition:
Vote positif 0 Vote négatif
pierrejean

pierrejean

XLDnaute Barbatruc
Re : Adapter macro : enlever doublon

bonjour Gorfael

et bravo pour tes 2 codes !!

la sub ListeValUniques(......

exploite en fait la particularité d'un collection a savoir

refuser d'accepter 2 items identiques

pour peu qu'il y ait une clé (en l'occuernce cstr(Elt))

afin que la macro tourne quand même on utilise

on error resume next puis on error goto 0

dans la collection on a donc la liste sans doublon

dont on peut faire ce que l'on veut

dans cette macro il me semble que le Arr2 est superflu , mais je n'ais pas testé
 
Vote positif 0 Vote négatif
Gorfael

Gorfael

XLDnaute Barbatruc
Re : Adapter macro : enlever doublon

Salut pierrejean, Nat54 et les autres

exploite en fait la particularité d'un collection a savoir

refuser d'accepter 2 items identiques
Cliquez pour agrandir...
sur la clé uniquement
je ne pense pas que ce soit judicieux ici, mais pour charger une listbox par exemple. Ou peut-être pour des opérations de trit. Bref, comme disait Pépin, il va falloir que je regarde les collections de plus près, ça peut donner des résultats interessants :D
A+
 
Vote positif 0 Vote négatif
pierrejean

pierrejean

XLDnaute Barbatruc
Re : Adapter macro : enlever doublon

@Gorfael

heureuse decision de te pencher sur les collections

entre autres avantages il y a celui de la vitesse d'execution

vois la difference entre le code avec la collection
et le tien pour une liste non triée

je n'ais pris que 750 lignes alors imagine au dela (le nombre d'iteration est une factorielle)
 
Vote positif 0 Vote négatif

Discussions similaires

Lu76Fer
  • Question
XL 2016 Notation Simplifiée pour définir un tableau arborescent
Réponses
9
Affichages
630
Lu76Fer
Lu76Fer
halecs93
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
674
halecs93
halecs93
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
158
sebastien176
S
B
  • Résolu(e)
Microsoft 365 Besoin d'aide pour faire fonctionner 2 codes VBA ensemble
Réponses
2
Affichages
175
BenExcel
B
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Code afficher/Masquer problème
Réponses
10
Affichages
296
chaelie2015
chaelie2015
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU)Nombre de cellule non vide et sans doublon
Réponses
2
Affichages
442
chaelie2015
chaelie2015
O
  • Question
XL 2019 Je veux afficher mes données dans ma Listbox1 avec l'entete de ma Base donnée et fait la recherche sans que cela derange l'entete.
Réponses
6
Affichages
510
ChTi160
ChTi160
S
  • Question
XL 2013 recherche intuitif semi automatique dans Combobox (trié et avec valeur unique) inseré en UserForm VBA
2
Réponses
18
Affichages
537
Sghaier Chafaa
S
T
  • Question
XL 2016 Code VBA sous un macos
Réponses
4
Affichages
311
telemarrk
T
A
  • Résolu(e)
Microsoft 365 Vider des listes déroulantes en cascade
Réponses
6
Affichages
376
Franc58
F

Membres actuellement en ligne

22 membres et 190 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 514
Messages
2 089 216
Membres
104 066
dernier inscrit
il matador