XL 2016 Supprimer enregistrement identique

KTM

XLDnaute Impliqué
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.
 

Pièces jointes

  • tri.xlsm
    9.1 KB · Affichages: 31

job75

XLDnaute Barbatruc
Bonjour KTM, kiki29, Jacky67, Pierre,

Voyez le fichier joint et la macro du bouton :
VB:
Private Sub CommandButton1_Click()
Dim P As Range, Q As Range, Prc&, Qrc&, R As Range, S As Range
Set P = [A1].CurrentRegion: Prc = P.Rows.Count - 1
Set Q = [G1].CurrentRegion: Qrc = Q.Rows.Count - 1
If Prc * Qrc = 0 Then Exit Sub 'si un tableau est vide
Set P = P.Offset(1).Resize(Prc)
Set Q = Q.Offset(1).Resize(Qrc)
Application.ScreenUpdating = False
P.Copy Q(Qrc + 1, 1): Set R = Q(Qrc + 1, 1).Resize(Prc, P.Columns.Count)
Q.Copy P(Prc + 1, 1): Set S = P(Prc + 1, 1).Resize(Qrc, Q.Columns.Count)
P.EntireColumn.RemoveDuplicates Array(1, 3, 4)
Q.EntireColumn.RemoveDuplicates Array(1, 3, 4)
R.Cut P(Prc + Qrc + 1, 1): S.Cut Q(Prc + 1, 1)
P.Resize(Prc + Qrc).Delete xlUp: Q.Delete xlUp
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
Elle est très rapide car il n'y a pas de boucle.

A+
 

Pièces jointes

  • tri(1).xlsm
    21.9 KB · Affichages: 9

Jacky67

XLDnaute Barbatruc
Bonjour KTM, kiki29, Jacky67, Pierre,

Voyez le fichier joint et la macro du bouton :
VB:
Private Sub CommandButton1_Click()
Dim P As Range, Q As Range, Prc&, Qrc&, R As Range, S As Range
Set P = [A1].CurrentRegion: Prc = P.Rows.Count - 1
Set Q = [G1].CurrentRegion: Qrc = Q.Rows.Count - 1
If Prc * Qrc = 0 Then Exit Sub 'si un tableau est vide
Set P = P.Offset(1).Resize(Prc)
Set Q = Q.Offset(1).Resize(Qrc)
Application.ScreenUpdating = False
P.Copy Q(Qrc + 1, 1): Set R = Q(Qrc + 1, 1).Resize(Prc, P.Columns.Count)
Q.Copy P(Prc + 1, 1): Set S = P(Prc + 1, 1).Resize(Qrc, Q.Columns.Count)
P.EntireColumn.RemoveDuplicates Array(1, 3, 4)
Q.EntireColumn.RemoveDuplicates Array(1, 3, 4)
R.Cut P(Prc + Qrc + 1, 1): S.Cut Q(Prc + 1, 1)
P.Resize(Prc + Qrc).Delete xlUp: Q.Delete xlUp
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
Elle est très rapide car il n'y a pas de boucle.

A+
Hello job75
Le mois dernier ==> avec un tableau VBA :oops:
Aujourd'hui ==>sans boucle o_O
La semaine prochaine ????...(Sans code) ;) ;)
Bravo, une fois de plus
 

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Comparaison(1).xlsm
    995.2 KB · Affichages: 8

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 196
Messages
2 086 100
Membres
103 116
dernier inscrit
kutobi87