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.

 

[job75]

Teste avec mon fichier (3), le résultat du 1er tableau doit être A1:E18428.

 

[pierrejean]

Désolé de te contredire mais je pense que ta macro efface trop de lignes (celles qui sont remontées suite a l'effacement de doublons entre les tableaux)
Tu peux vérifier que dans mon résultat du 1er tableau il n'y a plus de doublon

 

[job75]

Attention : RemoveDuplicates supprime les doublons à partir du 2ème mais pas le 1er.

 

[pierrejean]

On est bien d'accord sur ce point

 

[dysorthographie]

Bonjour,

Sub Test()
Dim T1 As String, T2 As String, P1 As String, P2 As String
With ThisWorkbook.Sheets("Feuil1")
P1 = "SELECT * from [Feuil1$" & Replace(.Range(.Range("A1"), .Cells(.Cells.Rows.Count, "E").End(xlUp)).Address, "$", "") & "]"
P2 = "SELECT * FROM [Feuil1$" & Replace(.Range(.Range("G1"), .Cells(.Cells.Rows.Count, "K").End(xlUp)).Address, "$", "") & "]"
Dim SQL1 As String, SQL2 As String
SQL1 = P1 & " as  FRM1 left join (" & P2 & ") as FRM2 on FRM2.CODE=FRM1.CODE and FRM2.Statut=FRM1.Statut and FRM2.Age=FRM1.Age and FRM2.sexe=FRM1.sexe and FRM2.ttt=FRM1.ttt"
SQL1 = SQL1 & " WHERE FRM2.CODE is null"

SQL2 = P2 & " as  FRM1 left join (" & P1 & ") as FRM2 on FRM2.CODE=FRM1.CODE and FRM2.Statut=FRM1.Statut and FRM2.Age=FRM1.Age and FRM2.sexe=FRM1.sexe and FRM2.ttt=FRM1.ttt"
SQL2 = SQL2 & " WHERE FRM2.CODE is null"
End With
With CreateObject("AdoDb.Connection")
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    With .Execute(SQL1)
        T1 = .GetString(, , vbTab, vbCrLf, "")
        .Close
    End With
    With .Execute(SQL2)
        T2 = .GetString(, , vbTab, vbCrLf, "")
        .Close
    End With
    
 
    .Close
  
End With
With Sheets("Feuil1")
    With .UsedRange
        Range(.Range("A2"), .Cells(.Rows.Count, .Columns.Count)).Clear
    End With
    PressePapier = T1: .Range("A2").PasteSpecial xlPasteAll
    PressePapier = T2: .Range("G2").PasteSpecial xlPasteAll
    ClearCipboard
End With

End Sub

Public Property Let PressePapier(Value)
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .SetText Value
    .PutInClipboard
 End With
End Property
 
Public Property Get PressePapier()
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .GetFromClipboard
    PressePapier = .GetText
End With
End Property
Function ClearCipboard()
'Early binding will requires a Reference to 'Microsoft Forms 2.0 Object Library'
    Dim oData  As Object    'New MSForms.DataObject

    Set oData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    oData.SetText Text:=Empty
    oData.PutInClipboard
    Set oData = Nothing
End Function

 

[pierrejean]

Bonjour dysorthographie
Quel est l'objectif de ta macro ?
dans ce post l'objectif est la suppression des doublons (dans chaque tableau et entre tableaux avons nous supposé )

 

[dysorthographie]

Désolé j'ai sans doute rien compris, je pensais qu'il voulait supprimer les lignes identique dans les deux tables ce qui ne veut pas dire doublon !

Dans la mesure ou ta solution est reconnu au poste #17 je suis hors sujet.

 

[mapomme]

bonjour @dysorthographie ,

Désolé j'ai sans doute rien compris, je pensais qu'il voulait supprimer les lignes identique dans les deux tables ce qui ne veut pas dire doublon !

Du coup, tout comme toi. Je suis donc hors sujet aussi !

 

[job75]

Hors sujet ??? Je te rappelle ma pomme que ta solution et la mienne donnent les mêmes résultats.

Sur mon fichier (3) du post #21 où chaque tableau est sans doublon.

 

[job75]

Bonjour le fil, le forum,

A l'exception de Jacky67 je pense qu'on n'a pas bien compris ni testé les macros de mon fichier (3) du post #21 :

- les tableaux initiaux - A1:E18832 et G1:K18813 - sont sans doublon sur les colonnes 1 3 4

- la macro test_pierrejean est la macro originale de pierrejean corrigée avec les tableaux VBA remplacés par des plages (Range)

- comme Jacky67 au post #14 je l'ai testée, chez moi elle s'exécute en 1h 5mn

- elle donne les mêmes résultats que test_job75 et test_mapomme à savoir les plages A1:E18428 et G1:K18409 (les lignes en commun sont supprimées dans les deux tableaux).

Bonne journée.

 

[KTM]

Bonjour le fil, le forum,

A l'exception de Jacky67 je pense qu'on n'a pas bien compris ni testé les macros de mon fichier (3) du post #21 :

- les tableaux initiaux - A1:E18832 et G1:K18813 - sont sans doublon sur les colonnes 1 3 4

- la macro test_pierrejean est la macro originale de pierrejean corrigée avec les tableaux VBA remplacés par des plages (Range)

- comme Jacky67 au post #14 je l'ai testée, chez moi elle s'exécute en 1h 5mn

- elle donne les mêmes résultats que test_job75 et test_mapomme à savoir les plages A1:E18428 et G1:K18409 (les lignes en commun sont supprimées dans les deux tableaux).

Bonne journée.

Je pense que ce fil peut se fermer.
Retenons la méthode job75. Elle est fantastique !

 

[pierrejean]

La nuit portant conseil je peux simplifier ma dernière macro

Sub test_pj5()
Feuil2.[A:K].Copy [A1] 'initialisation
t = Timer
derlin1 = Range("A" & Rows.Count).End(xlUp).Row
derlin2 = Range("G" & Rows.Count).End(xlUp).Row
'associer le chiffre 1 au tableau1 en colonne F et le chiffre 2 au tableau2
Range("F2:F" & derlin1) = 1
Range("L2:L" & derlin2) = 2
'copier le tableau2 a la suite du tableau1
Range("$G$2:$L$" & derlin2).Copy Destination:=Range("A" & derlin1 + 1)
derlin3 = Range("A" & Rows.Count).End(xlUp).Row
'supprimer les doublons
Range("$A$2:$F$" & derlin3).RemoveDuplicates Columns:=Array(1, 3, 4)
'recuperer la 1ere ligne ayant le chiffre 2 en colonne F (ici commence le tableau2 sans doublon
Set c = Columns("F").Find(2)
'reporter le tableau2 a sa place initiale
Range("A" & c.Row & ":F" & derlin3).Copy Destination:=Range("G2")
'supprimer le tableau2 en fin de tableau1
Range("A" & c.Row & ":F" & derlin3).Delete shift:=xlUp
'effacer les colonnes de reperage
Columns("F").ClearContents
Columns("L").ClearContents
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

Elle donne comme résultat 2 tableaux de 18831 et 18408 lignes soit 37239 lignes uniques
NB: Chez moi la macro de mapomme collecte 37185 valeurs uniques et celle de Gerard 36835
Enfin mes macros Test_pj test_pj2 et test_pj5 donnent le meme resultat bien que baséees sur des methodes differentes

Enfin il est possible en manuel de créer un tableau unique étant la somme des 2 tableaux ,oter les doublons et constater que le nombre de valeurs uniques est donné a 37240 valeurs (j'attribue la derniere valeur a "" "" "") cela demande moins d'1 minute !!!

 

[pierrejean]

J'ai enfin compris !!!
Toutes mes excuses à Gerard et à tous
Effectivement dans mes macros je n'efface que les doublons alors que Gerard efface aussi le 1er