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
Du coup, tout comme toi. Je suis donc hors sujet aussi !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 !
Je pense que ce fil peut se fermer.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.
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