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...

[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

[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

[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

[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

[FCL31]

Code :

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

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

j'y avais même pas pensé

Code :

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

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

Erreur sur

Code :

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

Sheets("Doublons"). Range("A" & i).Paste

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

Erreur sur la ligne

Code :

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

Range("A" & i & ":" & "W" & i).Copy Worksheets("Doublons").Range("A" & k)

Avec i = 3377 et K =65536
Rien de particulier en A3377 donc je pense que le problème vient de K

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
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

Je dois avouer que j'ai pas tester car il me semble qu'il doir manquer quelque chose car nule part il n'est question de la feuille "Doublons".
Normal ou erreur ??

Je continu à voir de mon coté avec mon code en modifiant avec les votre mais au bout de 1/4 heure et je suis loin arriver à la fin (i=7).
Il va falloir une éternité pour finir.

Si vous avez des idées.

Bonne journée
A+

[casefayere]

Je dois avouer que j'ai pas tester car il me semble qu'il doit manquer quelque chose car nulle part il n'est question de la feuille "Doublons".

j'en ai pas besoin, on supprime direct

adaptes les codes et essayes-les

[FCL31]

Je veux pas les supprimer

Je veux les garder sur la feuilles "MACHINES" et en faire une copie sur la feuilles "Doublons" pour faire un récap des erreur sur le fichier sans modifier les données fournnies

[parmi]

Si j'étais toi, j'essaierais avec une formule qui inscrit un X si doublon, tu filtres les données sur ces X, tu copies la plage et tu supprimes la colonne de X. Tout ça se fait très bien par macro si la formule n'est pas trop complexe, c'est-à-dire le nombre de colonnes à vérifier en cas de doublons.

D'après moi, ce sera pas mal plus rapide que de boucler avec 1 ou 2 boucles...

[FCL31]

Re

J'ai voulu tester une autre méthode qui serait (je pense) plus rapide :

Partant sur le principe que la recherche de doublons à l'aide de la mise en forme conditionnelle marche très bien et est rapide, à l'aide de l'enregistreur de macro, j'ai fais le code suivant :

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
Sub Test_Doublons()
 
    Cells.FormatConditions.Delete
    Range("I2").Select
    Range("I2").FormatConditions.Add Type:=xlExpression, Formula1:="=NB.SI(I:I;I2)>1"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
 
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Selection.Copy
    Columns("I:I").Select
    Range("I2").Activate
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
 
 
 
    DerLi = Range("G60000").End(xlUp).Row
 
For i = 2 To DerLi
    Worksheets("MACHINES").Select
    If Range("I" & i).Interior.ColorIndex = 49407 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 i
 
End Sub

Comme on a plus que une seule boucle, c'est forcement plus rapide.

Sauf que je pense que ces lignes ne marchent pas :

Code :

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

1
2
    If Range("I" & i).Interior.ColorIndex = 49407 Then
        Range("A" & i & ":" & "W" & i).Select

Je pense qu'il n'est pas possible de se servir de la couleur de fond des cellules comme conditions de sélection.

Existe t-il un moyen de le faire ???

Bonne journée
A+

Si j'étais toi, j'essaierais avec une formule qui inscrit un X si doublon, tu filtres les données sur ces X, tu copies la plage et tu supprimes la colonne de X. Tout ça se fait très bien par macro si la formule n'est pas trop complexe, c'est-à-dire le nombre de colonnes à vérifier en cas de doublons.

D'après moi, ce sera pas mal plus rapide que de boucler avec 1 ou 2 boucles...

Excuse moi, j'avais pas vu ton message.

Je dois avouer que je comprend pas trop se que tu veux dire

[Marc-L]

Sinon une boucle et la méthode Find associée à un objet Range est rapide avec le rafraîchissement de l'écran désactivé …

Consulter donc l'aide de cette méthode et l'exemple.

Voir aussi son application dans la discussion Simplification de code …

[FCL31]

Je viens de regarder et je dois avouer que je comprend pas trop le fonctionnement donc, je ne sais pas comment je pourrait l'utiliser.

Mais c'est peut être une bonne piste.

[casefayere]

Je veux pas les supprimer

Je veux les garder sur la feuilles "MACHINES" et en faire une copie sur la feuilles "Doublons" pour faire un récap des erreur sur le fichier sans modifier les données fournnies

eh bien il suffit de remplacer cette ligne sur ma proposition

Code :

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

.Rows(X).Delete

[parmi]

Excuse moi, j'avais pas vu ton message.

Je dois avouer que je comprend pas trop se que tu veux dire

C'est difficile à expliquer sans voir tes données, mais disons que les valeurs que tu veux vérifier sont en G et I pour déterminer s'il y a doublon, tu peux inscrire une formule à droite de tes données

Au préalable, tu tries tes données pour que ces valeurs se suivent, donc un tri sur colonne G et I et tu mets cette formule à droite

Code :

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

=SI(ET(OU(G2=G1;G2=G3);OU(I2=I1;I2=I3));"X";"-")

Tu copies cette formule dans chaque ligne jusqu'en bas.

Cette formule va te mettre un X aux 2 lignes identiques, sinon il y aura un tiret.
Tu peux alors faire un Filtre sur la colonne des formules pour avoir seulement les X

Il te reste à copier la plage qui résulte dans la feuille où tu veux les copier.