Discussion :

[FCL31]

Bonjour à tous

J'ai fais une macro mais mon problème, c'est que je ne suis même pas sur quelle fonctionne :

J'ai un tableau avec environ 8000 lignes.

J'ai fait un code qui permet de vérifier les doublons.
Lorsque la macro en trouve, il copie les deux ligne sur une autre feuille du classeur.

Voici mon code :

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
45
46
47
48
49
50
51
52
53
54
55
56
Sub Doublons()
 
DerLi = Range("G60000").End(xlUp).Row
 
For i = 1 To DerLi
For j = 1 To DerLi
    Worksheets("MACHINES").Select
    If Range("I" & i).Value = Range("I" & j).Value And i <> j Then
        Range("A" & i & ":" & "W" & i).Select
        Selection.Copy
        Sheets("Doublons").Select
        Range("A" & i).Select
        ActiveSheet.Paste
    Worksheets("MACHINES").Select
        Range("A" & j & ":" & "W" & j).Select
        Selection.Copy
        Sheets("Doublons").Select
        Range("A" & j).Select
        ActiveSheet.Paste
    End If
Next j
Next i
 
For x = 1 To DerLi
For y = 1 To DerLi
    Worksheets("MACHINES").Select
    If Range("G" & x).Value = Range("G" & y).Value And i <> j Then
        Range("A" & x & ":" & "W" & x).Select
        Selection.Copy
        Sheets("Doublons").Select
        Range("A" & x).Select
        ActiveSheet.Paste
    Worksheets("MACHINES").Select
        Range("A" & x & ":" & "W" & y).Select
        Selection.Copy
        Sheets("Doublons").Select
        Range("A" & x).Select
        ActiveSheet.Paste
    End If
Next y
Next x
 
    Worksheets("MACHINES").Select
    Range("A1:W1").Select
    Selection.Copy
    Sheets("Doublons").Select
    Range("A1").Select
    ActiveSheet.Paste
 
    Columns("G:G").Select
    Range("A2:W9987").Sort Key1:=Range("G1"), Order1:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
 
 
End Sub

Le code compare les cellules I de toute les lignes et si il y a un doublons, on copie la première ligne du doublons dans la seconde feuille et ensuite, on copie la seconde ligne du doublons dans la seconde feuille.
On fait la même chose pour les cellules G.
Et pour finir, (c'est une solution que je ne veut laisser définitive), on copie la première ligne de la première feuille et on fait un tri pour supprimer les lignes vides en fait.

Se code n'est pas fait pour des feuilles avec beaucoup de ligne.
Il compare chaque ligne avec les autres lignes une à une et je lui demande de le faire deux fois.
Si je ne me trompe pas, avec 8000 ligne, la macro fait environ 128 000 000 comparaisons.
C'est un peut beaucoup trop long et chaque fois Excel plante (pas de message d'erreur) mais obligé de passer par le gestionnaire de tache pour pouvoir débloquer le PC.

Donc, existe t-il un moyen de simplifier le code ??

Merci d'avance de votre aide si vous avez compris se que j'ai écrie.

Bonne journée
A+

[parmi]

Sans VBA, tu pourrais trier tes données et mettre une formule qui vérifie les données de la ligne en cours avec la précédente. Si identiques, tu mets un "X"
Il te reste à filtrer la liste pour avoir tes doublons. Si tu as besoin d'avoir les 2 (ou plus) lignes, tu peux vérifier dans ta formule, la ligne précédente ainsi que la suivante avec un OU.

Si tu tiens à passer par une macro, je pense que la 2e boucle devrait commencer à I plutôt que 1
ex:

Code :

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

1
2
3
4
5
For i = 1 To DerLi
For j = i To DerLi
    Worksheets("MACHINES").Select
    If Range("I" & i).Value = Range("I" & j).Value And i <> j Then
.............

Ça éviterait de refaire le parcours déjà fait, il me semble...

[EngueEngue]

sinon tu as removeduplicates

Code :

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

1
2
3
Sub virerdoublons()
ActiveSheet.Range("A1:Z8000").RemoveDuplicates Columns:=Array(7,10), Header:=xlYes
End sub

[Marc-L]

Bonjour.

sinon tu as removeduplicates

Code :

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

1
2
3
Sub virerdoublons()
ActiveSheet.Range("A1:Z8000").RemoveDuplicates Columns:=Array(7,10), Header:=xlYes
End sub

Et non, pas en 2003 ‼

Sinon la présentation initiale mériterait des éclaircissements
car je ne comprend pas le but de copier les doublons pour en supprimer …

Pourquoi ne pas les supprimer directement ? Ce serait encore plus rapide …

[EngueEngue]

Je rouille je n'ai même pas regardé :S... Merci de me mettre plein de -1

[casefayere]

Sinon, sans connaître le temps que ça prendra :

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
Dim DerLi As Long
 
 
Sub Test_doublons()
With Sheets("MACHINES")
   DerLi = .Range("G" & .Rows.Count).End(xlUp).Row
   IdentifieDoublons Range("I2:I" & DerLi)
End With
End Sub
 
Sub IdentifieDoublons(plg)
Dim Un As Collection
Set Un = New Collection
Dim X As Long
On Error Resume Next
With Sheets("MACHINES")
   For X = DerLi To 2 Step -1
      If .Range("I" & X) <> "" Then
         Un.Add .Range("I" & X), CStr(.Range("I" & X))
         If Err <> 0 Then
            .Rows(X).Delete
          End If
          Err.Clear
      End If
   Next X
End With
Set Un = Nothing
End Sub

[mercatog]

En utilisant une seule boucle optimisée (comme dans ton exemple)

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
Sub Doublons()
Dim DerLi As Long, i As Long, j As Long, k As Long
 
Application.ScreenUpdating = False
With Worksheets("MACHINES")
    DerLi = .Cells(.Rows.Count, "G").End(xlUp).Row
    k = 2
    .Range("A1:W1").Copy Worksheets("Doublons").Range("A1")
    For i = 1 To DerLi - 1
        For j = i + 1 To DerLi
            If .Range("G" & i).Value = .Range("G" & j).Value Or .Range("I" & i).Value = .Range("I" & j).Value Then
                Range("A" & i & ":" & "W" & i).Copy Worksheets("Doublons").Range("A" & k)
                Range("A" & j & ":" & "W" & j).Copy Worksheets("Doublons").Range("A" & k + 1)
                k = k + 2
            End If
        Next j
    Next i
End With
 
With Worksheets("Doublons")
    .Range("A2:W" & k).Sort Key1:=.Range("G2"), Order1:=xlAscending, Header:=xlNo
End With
End Sub

[COCONUT2]

Bonjour

1ere remarque:

Code :

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

1
2
For i = 1 To DerLi
For j = 1 To DerLi

Pourquoi recomparer chaque ligne en recommençant en haut du tableau

Code :

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

1
2
For i = 1 To DerLi -1
For j = i+1 To DerLi

Déjà tu vas gagner un peu de temps.


ensuite, je suggere de supprimer les select

Code :

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

1
2
3
4
Range("A" & i & ":" & "W" & i).Select
        Selection.Copy
        Sheets("Doublons").Select
        Range("A" & i).Select

peut aisément devenir

Code :

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

1
2
Range("A" & i & ":" & "W" & i).Copy
        Sheets("Doublons"). Range("A" & i).Paste

tu as récupéré les select de l'enregistreur de macro mais ils sont tres gourmands en ressources.

Je pense que commencer par ca te permettra d'optimiser ton code.

Christophe