Aide pour optimisation code doublons spécifique svp

**RyuAutodidacte** · 11/02/2016, 17h12

MAJ faites au messages N°6

Bonjour,
j'aimerai de l'aide pour optimisé mon code afin qu'il soit le plus rapide pour traiter des milliers de lignes.
Je suis pas du genre à copier bêtement et préfère de partir de zéro.
j'en ai fait un qui marche mais surement avec des erreurs de débutant dans la façon de programmer ou de manière maladroite
le voici :

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 Supp_doublons()
Dim c As Range, MaDonnee As Range
Dim Der_ligne As Long
 
Application.ScreenUpdating = False
Der_ligne = Range("A" & Range("ZZ1").End(xlDown).Row).End(xlUp).Row
    For i = 1 To Der_ligne
        MaCellule = Range("A" & i).Row
        Set MaDonnee = Range("A" & MaCellule)
        Set c = Range("A" & MaCellule + 1 & ":" & "A" & Der_ligne + 1).Find(MaDonnee, , xlValues, xlWhole)
        If c Is Nothing Then
        ElseIf c = "" Then
        Else
            MaDonnee.EntireRow.Delete
            Der_ligne = Der_ligne - 1
            i = i - 1
        End If
Set c = Nothing
        If i = Der_ligne Then
            Exit For
        End If
    Next i
Application.ScreenUpdating = True
End Sub

Merci d'avance

**joe.levrai** · 11/02/2016, 17h16

Bonjour,

la gestion des doublons bénéficie d'un outil clé en main dans Excel : Onglet "Donnée" >> "Supprimer les Doublons"

tu peux choisir ta plage de données et la (ou les) colonne(s) où les doublons à vérifier sont situés

entraines-toi sur cet outil, et quand tu as trouvé les bonnes actions à faire : tu refais ça au propre avec l'enregistreur de macro

tu auras une base de code qui utilise cet outil (méthode RemoveDuplicates en VBA) qu'il te suffira d'adapter

c'est quasi instantané, aucune boucle à faire, rien de chez rien

**RyuAutodidacte** · 11/02/2016, 17h37

Je ne sais pas si c'est la version Mac ou une mauvaise utilisation de ma part mais en enregistrant ma macro puis direction onglet "données" je ne trouve pas d'option supplémentaires quand je clique sur le bouton supprimer les doublons mis à part le choix de colonnes; et le pire , une fois la macro enregistré quand je vais voir le code il y'a juste un début et fin de sub sans code entre les 2
???

**letienne** · 11/02/2016, 17h45

Bonjour,
de manière générale, c'est très long d'affecter des objets range à une variable à chaque pas d'une boucle.
Tu peux trouver de l'aide sur RemoveDuplicates dans l'aide vba aussi.
Les filtres avancés dans menu données permettent aussi de faire une extraction sans doublons.

**joe.levrai** · 12/02/2016, 08h44

Bonjour,

un exemple avec le filtre avancé, pour rester sur l'idée de letienne
tutoriel de cet outil : http://philippetulliez.developpez.co...dvancedfilter/

ça crée une nouvelle feuille, et ça importe uniquement les lignes de ta base (située dans "Feuil1") sans doublon en colonne A

A adapter si besoin

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub DoublonColonneA()
Dim Destination As Worksheet, Source As Worksheet
Set Destination = Worksheets.Add: Set Source = Worksheets("Feuil1")
With Destination
    .Cells(1, 1).Value = Source.Cells(1, 1)
    .Cells(2, 1).Value = "<>"
    Worksheets("Feuil1").Cells(1, 1).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
                                                                  CriteriaRange:=.Cells(1, 1).CurrentRegion, _
                                                                  CopyToRange:=.Cells(4, 1), _
                                                                  Unique:=True
    .Cells(1, 1).Resize(3, 1).EntireRow.Delete
End With
 
End Sub

Pour ne pas devoir créer une nouvelle feuille, on peut prendre ma piste, l'outil removeDuplicates :

Code :

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

1
2
3
Sub RemoveDup()
    Worksheets("Feuil1").Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

Ca supprime directement les lignes où y'a un doublon en colonne A : c'est la première occurrence qui est conservée (les autres sont supprimés)

**RyuAutodidacte** · 12/02/2016, 10h43

Bonjour,
Merci Joe je vais regarder ça de plus près; par contre concernant le removeduplicates qui supprime la 1ère occurence ne m'arrange pas dut tout je vais mettre un exemple de mon fichier qui n'est pas parfait mais qui à l 'avantage de montrer le résultat voulu :
TEST Doublons.xls

MAJ : pour être plus précis de ce que j aimerais faire, ce n'est pas un simple code sur les doublons (bien sur faut bien commencer par les bases), mais un code qui propose plusieurs possibilité sur la gestion des doublons, dont une partie du code principal serai repris pour les différentes options :
PS : il se peut qu'il y ai des lignes vides et donc le currentregion n'est pas forcément adapté d'où un "der_ligne" pour connaitre la taille de la plage

• option 1 : supprimer les doublons sans forcément supprimer les lignes vides
- avoir le choix de supprimer soit la 1è occurrence doublon ou la dernière occurrence doublon

• option 2 : supprimer les doublons et supprimer les lignes vides
- avoir le choix de supprimer soit la 1è occurrence doublon ou la dernière occurrence doublon

• option 3 : Imaginons que nous avons plusieurs doublons (3 - 4) et que l'on veut avoir le choix de garder celui que l'on veut, genre un imputbox mettant un message avec les différents doublons numérotés dans l'ordre avec leurs infos, cela permettrait de sélectionner celui que l'on veut : exemple :

1 - REF1 INFO1 INFO2 INFO3 INFO4 INFO5 INFO6 INFO7
2 - REF1 INFO8 INFO9 INFO10 INFO11 INFO12 INFO13 INFO14
3 - REF1 INFO15 INFO16 INFO17 INFO18 INFO19 INFO20 INFO21

on indiquerait par exemple que l'on veut garder le 2è doublon les 2 autres serait supprimer

• option 4 : Trier et colorer les doublons exemple (chaque séparation représente un couleur cellule différente, 1 sur 2) :
——————————————————————————————————————————
REF1 INFO1 INFO2 INFO3 INFO4 INFO5 INFO6 INFO7
REF1 INFO8 INFO9 INFO10 INFO11 INFO12 INFO13 INFO1
————————————————————————————————————————––—
REF2 INFO1 INFO2 INFO3 INFO4 INFO5 INFO6 INFO7
REF2 INFO8 INFO9 INFO10 INFO11 INFO12 INFO13 INFO14
REF2 INFO15 INFO16 INFO17 INFO18 INFO19 INFO20 INFO21

• option 5 : supprimer les lignes vides (partie surement simple à faire)

voilà vous savez tout sur le chantier en cours

**RyuAutodidacte** · 15/02/2016, 02h13

hello,
pour ceux que ça interesse (je vais essayer d'avoir des étoile en plus

) je fais avancer le sujet en espérant toujours de l'aide pour trouver les problématiques pour faire les codes et une fois qu'ils sont fait comment les optimiser.
Soyez indulgent svp je ne fais pas tous les jours du vba et de l'excel !!

j'ai fait les codes des options 4 et 5

Option 4 : Trier et colorer les doublons 1 ligne sur 2

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Sub ValDebFin()
Dim Der_ligne As Long
Dim cpt As Integer
Dim Inve As Boolean
 
Application.ScreenUpdating = False
 
Der_ligne = Range("A" & Range("ZZ1").End(xlDown).Row).End(xlUp).Row
 
Range("A1" & ":" & "H" & Der_ligne).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, Orientation:=xlTopToBottom
 
cpt = 1
 
Inve = True
 
For i = 1 To Der_ligne
    If Range("A" & i) <> Range("A" & i + 1) Then
        cpt = 1
        If Inve = True And cpt = 1 Then
            Inve = False
        Range("A" & i).Resize(cpt, 8).Interior.ColorIndex = xlNone
        Else
            Inve = True
            Range("A" & i).Resize(cpt, 8).Interior.ColorIndex = 6
        End If
    Else
        Do
        cpt = cpt + 1
        i = i + 1
        Loop Until Range("A" & i) <> Range("A" & i + 1)
        If Inve = True And cpt >= 1 Then
            Inve = False
            Range("A" & i - cpt + 1).Resize(cpt, 8).Interior.ColorIndex = xlNone
        Else
            Inve = True
            Range("A" & i - cpt + 1).Resize(cpt, 8).Interior.ColorIndex = 6
        End If
    End If
    cpt = 1
Next
 
Application.ScreenUpdating = True
End Sub

Option 5 : supprimer les lignes vides

Code :

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

1
2
3
4
5
Sub Supp_Lignes_Vides()
Application.ScreenUpdating = False
    Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub

Voilà, j'attends vos réponse avec impatience

PS : l'option 1 se trouve sur mon 1er code a quelques détails sur les option pour supprimer le 1er doublon ou le dernier doublon

**casefayere** · 12/03/2016, 17h06

Bonsoir,

Je n'ai pas relu toutes les interventions, mais pour reprendre le problème à sa base,
Un Dico ne serait pas plus utile ?
Ci-dessous, un code qui supprime les doublons et les lignes vides pour coller à un autre endroit, à voir et à adapter à ta situation si j'ai compris le problème, en espérant ne pas être à coté de la plaque

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
25
Sub Listeunique()
Dim mondico As Object, a, b, i As Long, dercel As Range, c As Range
  Set mondico = CreateObject("Scripting.Dictionary")
  'ci-dessous tableau qui reprend les valeurs de la col A
  Set dercel = Range("A" & Rows.Count).End(xlUp)
  a = Range("A2", dercel)
  'ci-dessous tableau qui reprend les valeurs de la col B
 
  Set dercel = Range("B" & Rows.Count).End(xlUp)
  b = Range("B2", dercel)
  'ci-dessous dico sur 2 colonnes sans doublon
  For i = LBound(a) To UBound(a)
    mondico(a(i, 1)) = ""
  Next i
  For i = LBound(b) To UBound(b)
    mondico(b(i, 1)) = ""
  Next i
  'ci-dessous, pour supprimer l'éventuelle valeur vide du dico
  For Each c In mondico.keys
      If c = "" Then mondico.Remove c
   Next c
   'ensuite, coller le résultat en "C"
  [c2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
  Set mondico = Nothing
End Sub