VBA
Résolu
Bilux
-
Steefif Messages postés 485 Date d'inscription Statut Membre Dernière intervention -
Steefif Messages postés 485 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
sur une feuille excel, j'ai une colonne qui contient plusieurs valeurs différentes.
je voudrait éliminer les doublons, c'est à dire travailler cette colonne de façons a ne pas avoir de valeur en double, un genre de " Select distinct" comme en SQL (sauf que je voudrait le faire en VBA
j'ai déja fait un algo, mais sa me parrait top lourd,
je commence par trier la colonne,ensuite si je trouve de cellules identique qui se suivent j'en supprime une, et a la fin je retrie la colonne.
' Trier la colonne A
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'
'supprimer les doublons
Dim Cel As Range
Set Cel = Sheets(2).Range("A1")
i = 0
Do While Cel.Offset(i) <> ""
If Cel.Offset(i) = Cel.Offset(i + 1) Then 'supprime les doublons
i = i + 1
Cel.Offset(i - 1) = ""
Else
i = i + 1
End If
Loop
'
' Retrier la colonne A
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'
quelqu'un à t il une idée d'un algo moins lourd ou des une fonction ?
Merci
sur une feuille excel, j'ai une colonne qui contient plusieurs valeurs différentes.
je voudrait éliminer les doublons, c'est à dire travailler cette colonne de façons a ne pas avoir de valeur en double, un genre de " Select distinct" comme en SQL (sauf que je voudrait le faire en VBA
j'ai déja fait un algo, mais sa me parrait top lourd,
je commence par trier la colonne,ensuite si je trouve de cellules identique qui se suivent j'en supprime une, et a la fin je retrie la colonne.
' Trier la colonne A
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'
'supprimer les doublons
Dim Cel As Range
Set Cel = Sheets(2).Range("A1")
i = 0
Do While Cel.Offset(i) <> ""
If Cel.Offset(i) = Cel.Offset(i + 1) Then 'supprime les doublons
i = i + 1
Cel.Offset(i - 1) = ""
Else
i = i + 1
End If
Loop
'
' Retrier la colonne A
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'
quelqu'un à t il une idée d'un algo moins lourd ou des une fonction ?
Merci
7 réponses
j'ai deja vu une solution proposée je ne sais plus ou.
cherche sur le net avec "supprimer des doublons avec excel"
tu devrais trouver.
*
edit
voilà ici
http://www.top-assistante.com/macros/doublons.php
une macro qui te fait ca
ell eest commentée
cherche sur le net avec "supprimer des doublons avec excel"
tu devrais trouver.
*
edit
voilà ici
http://www.top-assistante.com/macros/doublons.php
une macro qui te fait ca
ell eest commentée
je peux utiliser le filtre élaboré, mas le problémes c'est :
- que premierement je n'ai pas confiance en ce filtre, je préfére faire une macro moi même
- deuxiemement, le filtre change les numéro de ligne !!!!!!!!!!!!!
- que premierement je n'ai pas confiance en ce filtre, je préfére faire une macro moi même
- deuxiemement, le filtre change les numéro de ligne !!!!!!!!!!!!!
Merci, c'est pas trés différent de la macro que j'ai poster au début.
finalement j'ai fait ceci :
' Trier la colonne A
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'supprimer les doublons
Dim Cel As Range
Set Cel = Sheets(2).Range("A1")
i = 0
Do While Cel.Offset(i) <> ""
If Cel.Offset(i) = Cel.Offset(i + 1) Then 'supprimer les lignes double
Cel.Offset(i + 1).EntireRow.Select
Selection.Delete Shift:=xlUp
Else
i = i + 1
End If
Loop
je suppriume les ligns directement, sa m'évite de retrier une nouvelle fois
Merci en tout cas
finalement j'ai fait ceci :
' Trier la colonne A
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'supprimer les doublons
Dim Cel As Range
Set Cel = Sheets(2).Range("A1")
i = 0
Do While Cel.Offset(i) <> ""
If Cel.Offset(i) = Cel.Offset(i + 1) Then 'supprimer les lignes double
Cel.Offset(i + 1).EntireRow.Select
Selection.Delete Shift:=xlUp
Else
i = i + 1
End If
Loop
je suppriume les ligns directement, sa m'évite de retrier une nouvelle fois
Merci en tout cas
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
méfie toi, avec cette formule tu peux en rater
il faut pour ce faire que tu partes de la denriere cellule
en effet si tu supprime la ligne 2 et que la 3eme etait un doublons, elle va passer cellule 2, mais sans etre traiter
typiquement il faut faire ceci :
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
...
il faut pour ce faire que tu partes de la denriere cellule
en effet si tu supprime la ligne 2 et que la 3eme etait un doublons, elle va passer cellule 2, mais sans etre traiter
typiquement il faut faire ceci :
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
...
je ne pense pas, je ne passe a la ligne suivante que si elle est différente de la ligne actuel
If Cel.Offset(i) = Cel.Offset(i + 1) Then
Cel.Offset(i + 1).EntireRow.Select 'je supprime la ligne suivante sans bouger de ma place
Selection.Delete Shift:=xlUp
Else
i = i + 1 'je passe a la ligne suivante
End If
If Cel.Offset(i) = Cel.Offset(i + 1) Then
Cel.Offset(i + 1).EntireRow.Select 'je supprime la ligne suivante sans bouger de ma place
Selection.Delete Shift:=xlUp
Else
i = i + 1 'je passe a la ligne suivante
End If
