Macro VBA pour supprimer doublons ?

Version imprimable

24/08/2013, 00h30
Debutant10

Macro VBA pour supprimer doublons ?

Bonjour,

Je recherche savoir comment faire avec VBA pour supprimer les doublons de mon listing excel ?

Mon fichier fait 7 colonne et l'information en boublons et dans la colonne A.

Si un code existe comment puisse-je faire ?

Merci de votre aide svp.
24/08/2013, 00h39
casefayere

sur le site ou sur le forum tu trouveras facilement des conseils, notamment dans les tutos, Tu es sur excel 2007, alors la gestion des doublons est prévue, dans l'onglet "Données.
Bon courage
24/08/2013, 20h27
Debutant10

je recherche la méthode en VBA...

qq connait comment faire ?
24/08/2013, 21h09
clementmarcotte

Bonjour

Oui, l'enregistreur de macros d'Excel. Probablement tous les excelliens sont passés par là un jour ou l'autre.
24/08/2013, 21h24
gFZT82
Bonjour,

Pour t’initier à VBA, tu peux utiliser l’enregistreur de macro.
Voici un exemple de code enregistré avec une opération de suppression des doublons sur les colonnes A à G, celle contenant les doublons étant la colonne A et les colonnes n'ayant pas d'en-tête.
Code:

1 2 3 4 Sub Macro1() Columns("A:G").Select ActiveSheet.Range("$A$1:$G$21").RemoveDuplicates Columns:=1, Header:=xlNo End Sub
Pour plus de renseignements :
Initiation au VBA

Cordialement.
25/08/2013, 16h18
patricktoulon

heu

Bonjour a tous

bien que la methode remove duplicate excel2007 soit tres bien je ne l'utilise presque jamais car si le fichier est utilisé avec une version anterieure a 2007 c'est la catastrophe

l'utilisation de variables tableaux dans 2 boucles imbriquée voir le scripting dictionary me semble mieux indiqué
tu trouvera plusieur exemples sur le site et dans les contributions tu trouvera aussi divers exemples ilustrants cette methode dont la mienne

au plaisir

Sinon, un exemple simple, à adapter :

Code:

1
2
3
4
5
6
7
Option Explicit
Dim Dl As Integer, Ws As Worksheet
Sub Test_doublons()
Set Ws = Sheets("Feuil1")
   Dl = Ws.Range("a" & Ws.Rows.Count).End(xlUp).Row
   IdentifieDoublons Ws.Range("B2:B" & Dl)
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub IdentifieDoublons(Plg As Range)
Dim Un As Collection, cel As Range
Set Un = New Collection
On Error Resume Next
With Ws
   For Each cel In Plg
      If cel <> "" Then
         Un.Add cel, CStr(cel)
         If Err <> 0 Then
            .Range("A" & cel.Row, "b" & cel.Row).Interior.ColorIndex = 6 ' ou .Clear ou .ClearContents etc.
         End If
            'Efface toutes les valeurs de l'objet Err.
         Err.Clear
      End If
   Next cel
End With
Set Un = Nothing
End Sub

Bonjour, regarde ça

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Function Highlander(Init As Boolean, ParamArray Plage()) As Boolean
'..................................................
'La méthode Highlander, il ne peut en rester qu'un.
'Retourne True si doublon.
'..................................................
 
Static CollectDoublon As Collection
Dim T As String
Dim PlageIndex As Long
Dim myPlage As Range
Dim Col As Integer
If Init = False Then
Init = True
   Set CollectDoublon = Nothing
   Set CollectDoublon = New Collection
End If
 
 
T = "T"
For PlageIndex = 0 To UBound(Plage)
   Set myPlage = Plage(PlageIndex)
   For Col = 1 To myPlage.Columns.Count
    T = T & "_" & myPlage(1, Col)
   Next
Next
On Error Resume Next
CollectDoublon.Add T, T
If Err <> 0 Then Highlander = True
On Error GoTo 0
End Function

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub test()
Dim Init As Boolean
Dim MyRange As Range
Dim L As Long
Set MyRange = ActiveSheet.UsedRange
Debug.Print "Sur une colonne"
For L = 1 To MyRange.Rows.Count
    Debug.Print Highlander(Init, MyRange(L, 1))
Next
Init = False
Debug.Print "********************"
Debug.Print "Sur une plage colonne"
For L = 1 To MyRange.Rows.Count
    Debug.Print Highlander(Init, ActiveSheet.Range(MyRange(L, 1), MyRange(L, 2)))
Next
Init = False
Debug.Print "********************"
Debug.Print "Sur 2 colonnes"
For L = 1 To MyRange.Rows.Count
    Debug.Print Highlander(Init, MyRange(L, 1), MyRange(L, 3))
Next
Init = False
Debug.Print "********************"
Debug.Print "Sur deux plage colonne"
For L = 1 To MyRange.Rows.Count
    Debug.Print Highlander(Init, ActiveSheet.Range(MyRange(L, 1), MyRange(L, 2)), ActiveSheet.Range(MyRange(L, 3), MyRange(L, 4)))
Next
Init = False
Debug.Print "********************"
Debug.Print "Sur une plage colonne"
For L = 1 To MyRange.Rows.Count
    If Highlander(Init, ActiveSheet.Range(MyRange(L, 1), MyRange(L, 2))) = True Then MsgBox "Doublon"
Next
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub SupprimerDoublon()
Dim Init As Boolean
Dim MyRange As Range
Dim L As Long
Dim I As Long
Dim lignes() As Long
Set MyRange = ActiveSheet.UsedRange
Debug.Print "Sur 7 colonnes"
For L = 1 To MyRange.Rows.Count
   If Highlander(Init, ActiveSheet.Range(MyRange(L, 1), MyRange(L, 7))) = True Then
    ReDim Preserve lignes(I)
    lignes(I) = L
    I = I + 1
   End If
Next
 
For I = UBound(lignes) To 0 Step -1
    MyRange(lignes(I), 1).EntireRow.Delete
Next
End Sub