doublons

[ben]

Bonjour le forum

Je cherche à supprimer des doublons ds une colonne

j'ai par exemple ds la colonne C

18
19
15
19
14
19

je voudrai avoir

18
19
15
14


est ce possible ?

Merci pour votre aide

 

[wally]

Bonjour ben et le forum,

Une possibilité par VBA :

Sub Supprimer_Doublons()

Dim oRge As Range
Dim iRow As Integer
Dim cRge As New Collection

On Error Resume Next
For Each oRge In ActiveSheet.Range("C1:C" & ActiveSheet.Range("C65536").End(xlUp).Row)
If Not IsEmpty(oRge) Then
cRge.Add oRge.Value, CStr(oRge.Value)
End If
Next oRge
On Error GoTo 0

ActiveSheet.Columns("C").Clear

For iRow = 1 To cRge.Count
ActiveSheet.Range("C" & iRow) = cRge.Item(iRow)
Next iRow

End Sub


Slts

wally

 

[ben]

salut wally et le forum

Merci bien wally je viens d'essayer je te remercie beaucoup

 

[ben]

par contre wally peut tu m'expliquer se que c'est new collection ?
et je voudrai rajouter qd il me trouve un doublon m'effacer les donnée ds la colonne A et B.

merci beaucoup wally !

 

[wally]

Bonjour ben et le forum,

L'instruction "Dim cRge As New Collection" permet de créer un nouvel objet Collection, dont les éléments seront identifiés par une clé unique.

Lors de l'ajout d'un élément à cette collection (cf. instruction "cRge.Add oRge.Value, CStr(oRge.Value)"), on indique que la clé de ce nouvel élément est la valeur contenue dans la cellule traitée. Etant donné que la clé doit être unique, il sera impossible d'ajouter dans cette collection deux fois la même valeur. On supprime ainsi facilement les doublons...

Le but de l'instruction "On Error Resume Next" est d'éviter que le programme "plante" avec une erreur d'exécution '457': Cette clé est déjà associée à un élément de cette collection.

Voilà pour les explications ! Maintenant, pour effacer les données dans les colonnes A et B lors de la détection d'un doublon, il faut modifier légèrement le code :

Sub Supprimer_Doublons()

Dim oRge As Range
Dim iRow As Integer
Dim cRge As New Collection

On Error GoTo Doublon
For Each oRge In ActiveSheet.Range("C1:C" & ActiveSheet.Range("C65536").End(xlUp).Row)
If Not IsEmpty(oRge) Then
cRge.Add oRge.Value, CStr(oRge.Value)
End If
Next oRge
On Error GoTo 0

ActiveSheet.Columns("C").Clear

For iRow = 1 To cRge.Count
ActiveSheet.Range("C" & iRow) = cRge.Item(iRow)
Next iRow

Exit Sub

Doublon:
oRge.Offset(0, -2).Clear
oRge.Offset(0, -1).Clear
Resume Next

End Sub


Slts

wally

 

[ben]

merci wally mais je crois qu'il y a un petit souci :
je t'ai joint le fichier

ca donne des résultat bizarre
je t'ai mis avec une flèche les résultats que l'on devrai obtenir

 

[wally]

Re ben et le forum,

Et comme ceci (voir fichier joint) ?


Slts

wally

 

[ben]

non lol ca va pas j'arrive pas à comprendre pkoi
au départ on a :
6c 102 1
6c 102 1
6c 102 2
6c 102 2
6c 102 3

avec le code cela donne ceci :

6c 104 1
2
6c 104 3

6c 104

et le résultat correct serai :

6c 104 1

6c 104 2

6c 104 3


ca m'énerve je cherche de mon côté et je trouve rien

 

[michel]

Bonjour Ben , Bonjour Wally

peux tu tester la macro ci dessous

Sub EffaceLignesDoublons()
'http://www.excel-downloads.com/html/French/forum/messages/1_71835_71835.htm
'michel le 19.02.2004
Dim Cell As Range
Dim Ligne As Integer, i As Integer
Dim M As Integer, N As Integer
Dim U As Boolean
Dim Tableau(), Tableau2()

Ligne = Range("C65536").End(xlUp).Row ' derniere ligne non vide colonne A
M = 1
N = 1
ReDim Preserve Tableau(M) 'tableau valeurs uniques colonne A
ReDim Preserve Tableau2(N) ' tableau pour numero de lignes doublons

Application.ScreenUpdating = False
For Each Cell In Range("C1:C" & Ligne)
U = False
For i = 1 To M
If Cell = Tableau(i - 1) Then '
Tableau2(N - 1) = Cell.Row ' recupere numero de ligne quand un doublon est detecté
N = N + 1
ReDim Preserve Tableau2(N)
U = True
End If
Next i

If Tableau(M - 1) = "" And U = False Then
Tableau(M - 1) = Cell ' remplissage tableau valeurs uniques si pas de doublon détecté
M = M + 1
ReDim Preserve Tableau(M)
End If
Next Cell

For i = 1 To N - 1
Cells(Tableau2(i - 1), 1).Clear
Cells(Tableau2(i - 1), 2).Clear
Cells(Tableau2(i - 1), 3).Clear
Next i
Application.ScreenUpdating = True

End Sub


bonne journee
michel

 

[ben]

merci michel de te joindre à nous pour mon problème

cela me marque dépassement de capacité à cette ligne :

Ligne = Range("C65536").End(xlUp).Row ' derniere ligne non vide colonne A

 

[wally]

Re ben et le forum,

C'est bizarre... Je viens de refaire un essai avec le dernier fichier que je t'ai envoyé. Le résultat, APRES le lancement de la macro, se trouve dans la pièce jointe. N'est-ce pas ce que tu souhaites ???


Slts

wally

 

[ben]

j'ai trouvé pkoi j'avais le message michel, j'ai + de 45000 lignes ds mon documents j'en ai enlevé et ca marche mais comment puije faire faire pour toute mes lignes ?

 

[michel]

rebonjour Ben

au debut de la macro , dans les definitions des variables , remplace Integer par Long

bonne journee
michel

 

[ben]

wally, je comprends rien je refais la macro il me redonne
6c 104 1
2
6c 104 3

6c 104


au lieu de

6c 104 1

6c 104 2

6c 104 3

 

[ben]

merci michel j'avais essayé avec double aussi ca a l'air de marché également, je laisse tourner la macro

En tout cas un grand merci à vous 2 c'est vraiment sympa
je vais essayé de trouver la solution pour le code de wally et de comprendre le code de michel maintenant lol

merci beaucoup !!