Discussion :

[Calimero33]

Bonjour, j'ai trouvé dans le forum des exemples de suppression de doublons dans une plage de données range mais ça ne correspond pas à mon problème. Je souhaiterai ne garder que les valeurs uniques c'est à dire supprimer les deux valeurs des doublons et non pas une seule des deux valeurs. Actuellement mon code ne supprime qu'une valeur des doublons. Comment puis-je le modifier pour obtenir que les valeurs uniques de ma plage ? Je voudrais le faire en VBA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Dim Cellule As Variant
Dim maplage As Range
 
Set maplage = Range("A1:A173")
For Each Cellule In maplage
 
   If Cellule = Cellule.Offset(1, 0) Then
        Cellule.Offset(1, 0).Delete
End If
Next

[mercatog]

Une proposition

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub SupprDoub()
Dim LastLig As Long
Dim c As Range
Dim T As String
 
Application.ScreenUpdating = False
With Sheets("Feuil3")      'à adapter
   LastLig = .Cells(Rows.Count, "A").End(xlUp).Row
   For Each c In .Range("A2:A" & LastLig)
      If Application.CountIf(.Range("A2:A" & LastLig), c) > 1 Then T = T & ", " & c.Address
   Next c
   T = Mid(T, 2)
   If Len(T) > 0 Then .Range(T).EntireRow.Delete
End With
End Sub

[Calimero33]

merci de ta réponse, je l'ai essayé mais j'ai une erreur d'incompatibilité de type sur la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 For Each c In .Range("A1:A" & LastLig)
      If Application.CountIf(plage, c) > 1 Then T = T & ", " & c.Address
   Next c
 
   T = Mid(T, 2)

Est ce que tu pourrai me l'expliquer pour que j'essaye de trouver l'erreur ?
A quoi correspond plage , adress et Mid ?

[mercatog]

Primo, j'ai ré édité mon code (à cause d'une coquille)
secundo, le code fonctionne si le nombre de lignes en double est inférieur à 30,
sinon, ci-joint code plus général

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub SupprDoub()
Dim LastLig As Long, i As Long
Dim c As Range, plage As Range
Dim T() As String
 
Application.ScreenUpdating = False
ReDim T(1)
With Sheets("Feuil3")      'à adapter
   LastLig = .Cells(Rows.Count, "A").End(xlUp).Row
   For Each c In .Range("A1:A" & LastLig)
      If Application.CountIf(.Range("A1:A" & LastLig), c) > 1 Then
         T(UBound(T)) = c.Address
         ReDim Preserve T(UBound(T) + 1)
      End If
   Next c
   If UBound(T) > 1 Then
      Set plage = .Range(T(1))
      For i = 2 To UBound(T) - 1
         Set plage = Union(plage, .Range(T(i)))
      Next i
         plage.EntireRow.Delete
   End If
End With
End Sub

[Calimero33]

Un grand merci pour ce cou de pouce !! Ca marche
Est ce je pourrai avoir une explication du code parce que je debute en vba et j'avoue ne pas tout comprendre ...

[mercatog]

avec un peu de commentaire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub SupprDoub()
Dim LastLig As Long, i As Long
Dim c As Range, plage As Range
Dim T() As String
 
Application.ScreenUpdating = False
ReDim T(1)
With Sheets("Feuil3")      'à adapter
   LastLig = .Cells(Rows.Count, "A").End(xlUp).Row 'derniere ligne remplie (colonne A)
   For Each c In .Range("A1:A" & LastLig)          'pour chaque cellule c
      If Application.CountIf(.Range("A1:A" & LastLig), c) > 1 Then   'si la valeur de c se répète plus qu'une fois
         T(UBound(T)) = c.Address                                    'on met son adresse c.address dans un tableau T
         ReDim Preserve T(UBound(T) + 1)                             'qu'on redimensionne d'une "case" supplémentaire
      End If
   Next c
   If UBound(T) > 1 Then                                             'Si le tableau comporte au moins une addresse, bien sur le minimum est 2 existence d'au moins d'un doublon
      Set plage = .Range(T(1))
      For i = 2 To UBound(T) - 1                                     'on rassemble dans plage toutes les cellules dont les adresses sont contenus dans le tableau T
         Set plage = Union(plage, .Range(T(i)))
      Next i
         plage.EntireRow.Delete                                      'on supprime les lignes de plage
   End If
End With
End Sub

[Calimero33]

merci beaucoup, c'est parfait !