XL 2016 Supprimer enregistrement identique

[KTM]

Bonjour chers tous

Je voudrais supprimer par macro sur mes deux plages les lignes pour lesquelles le Code - l'Age - le sexe sont identiques.
Merci et bonne journée.

 

[mapomme]

Bonjour @job75 🙂
Tu as décidé de me faire travailler un dimanche ! 😳
🙂

 

[job75]

Tu as décidé de me faire travailler un dimanche ! 😳
🙂

Non ne travaille pas, je pense que la différence vient des doublons existant dans chaque tableau.

 

[Jacky67]

Bonjour le fil, le forum,

Dans le fichier joint je compare les 3 solutions sur 19 000 lignes (données aléatoires entre 1 et 100).

Notez que les résultats en nombre de lignes des 3 tests ne sont pas les mêmes.

J'ai bien vérifié les miens, ils sont justes.

A+

Re...
Impressionnant la différence de temps d'exécution entre pierre et job (154 s et 0.8 s chez moi)
Si je comprends la différence du nombre de ligne entre Job et mapomme, puisque mapomme ne supprime pas les doublons, je ne comprends pas celle entre pierre et job
Son code est simple et me semble sans erreur, non?
Y a t'il une explication??

 

[job75]

Dans ce fichier (2) j'ai supprimé les doublons de chacun des 2 tableaux de la feuille Initialisation.

mapomme et mois récupérons bien les mêmes lignes.

pierrejean récupère 2 lignes de plus.

 

[Jacky67]

pierrejean récupère 2 lignes de plus.

Re..
J'ai beau chercher, en long et en large( même en prenant Max(colonne(A), colonne(G)), je ne trouve pas d'où viennent ces deux lignes.
Une idée ??

 

[job75]

J'ai beau chercher, en long et en large( même en prenant Max(colonne(A), colonne(G)), je ne trouve pas d'où viennent ces deux lignes.
Une idée ??

La macro de pierrejean ne va pas parce qu'elle mélange tableaux VBA (invariables) et suppressions de lignes.

En remplaçant les tableaux VBA par des plages ça doit aller :

Sub test_pierrejean()
Feuil2.[A:K].Copy [A1] 'initialisation
t = Timer
Set tablo = Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row)
Set tablo1 = Range("G2:K" & Range("G" & Rows.Count).End(xlUp).Row)
For n = tablo.Rows.Count To 1 Step -1
  For m = tablo1.Rows.Count To 1 Step -1
     If tablo(n, 1) = tablo1(m, 1) And tablo(n, 3) = tablo1(m, 3) And tablo(n, 4) = tablo1(m, 4) Then
          Range("A" & n + 1 & ":E" & n + 1).Delete Shift:=xlUp
          Range("G" & m + 1 & ":K" & m + 1).Delete Shift:=xlUp
     End If
  Next
Next
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

Mais c'est terriblement long, essayez de tester ce fichier (3), moi j'ai abandonné.

 

[Jacky67]

La macro de pierrejean ne va pas parce qu'elle mélange tableaux VBA (invariables) et suppressions de lignes.

En remplaçant les tableaux VBA par des plages ça doit aller :
Mais c'est terriblement long, essayez de tester ce fichier (3), moi j'ai abandonné.

Re..
Oui c'est long, 137s, mais toujours deux lignes de plus pour tablo1 que la version job et mapomme
Pfff, c'est désespérant 😱

 

[job75]

C'est beaucoup plus que 137s, testez la macro de pierrejean sur mon fichier (3).

 

[Jacky67]

C'est beaucoup plus que 137s, testez la macro de pierrejean sur mon fichier (3).

Oui je confirme, 1h28mn pour des lignes identiques aux versions job et mapomme
J'avais tester la mauvaise version. J'ai eu le temps de faire ma promenade.😎

 

[pierrejean]

Re

Je m'escrime sur ce problème et voici ou j'en suis
1) en feuil1 correction de ma macro (nb :ici suivant l'exemple colorié du demandeur j'ai supprimé les 'doublons' entre les 2 tableaux et ignoré les doublons de chaque tableau)
J'ai bien au résultat le même nbre de lignes
2) en Module1 un essai au résultat curieux
Nb: ici je ne conserve qu'un doublon
mais en alternant les 2 lignes commentées j'obtiens les mêmes nbre de ligne que Gerard avec l'un ou l'autre des tableaux mais pas dans le second
Une idée ??
Enfin après une macro éternelle tester la macro pj2 qui repère les doublons

 

[job75]

Bonjour Pierre,

Difficile de savoir ce qui ne va pas.

Je vois que tu utilises Union pour grouper les plages à supprimer.

Tu sais certainement que cette méthode pédale dans la choucroute quand il y a un grand nombre de plages disjointes à grouper.

A+

 

[pierrejean]

Re
Je pense qu'ici UNION n'est pas en cause
En effet j'ai effectué la manip suivante :
En manuel suppression des doublons dans chaque tableau puis copie du tableau 2 a la suite du tableau1 et suppression des doublons dans ce nouveau tableau qui m'indique conserver 32740 valeurs uniques
ce chiffre correspond aux valeurs obtenues par les macros pj et pj2 soit 18812+18427 la dernière étant je suppose "" "" ""

 

[pierrejean]

Re

In fine je propose:

Sub test_pj3()
Feuil2.[A:K].Copy [A1] 'initialisation
t = Timer
derlin1 = Range("A" & Rows.Count).End(xlUp).Row
derlin2 = Range("G" & Rows.Count).End(xlUp).Row
Range("F2:F" & derlin1) = 1
Range("L2:L" & derlin2) = 2
Range("$A$2:$F$" & derlin1).RemoveDuplicates Columns:=Array(1, 3, 4)
Range("$G$2:$L$" & derlin2).RemoveDuplicates Columns:=Array(1, 3, 4)
Range("$G$2:$L$" & derlin2).Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
derlin3 = Range("A" & Rows.Count).End(xlUp).Row
Range("$A$2:$F$" & derlin3).RemoveDuplicates Columns:=Array(1, 3, 4)
Set c = Columns("F").Find(2)
Range("A" & c.Row & ":F" & derlin3).Copy Destination:=Range("G2")
Range("A" & c.Row & ":F" & derlin3).Delete shift:=xlUp
Columns("F").ClearContents
Columns("L").ClearContents
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

 

[job75]

Bonjour Pierre,

J'ai testé ta dernière macro avec mon fichier (3).

Le résultat du 2ème tableau en G1:K18409 est correct.

Mais le résultat du 1er en A1:E18832 ne va pas.

A+

 

[pierrejean]

Bonjour Gerard
Qu'est ce qu'il ne va pas ???
Il reste un doublon ? ou .....