Option Explicit Dim ng, nc, nd 'nombre gauche, nombre commun, nombre droite REM ======================================== REM Chercher les éléments communs et uniques REM dans deux colonnes de données REM ======================================== REM Instructions : REM copier une colonne dans la colonne 1 (garder l'en-tête en première ligne) REM copier l'autre colonne dans la colonne 2 (garder l'en-tête en première ligne) REM lancer la macro (Alt-F8) Parcourir REM ======================================== Sub Parcourir() ng = 0 nc = 0 nd = 0 Range("I22") = Time Dim i%, j%, derCell1, derCell2, n% Range("A1").Select '-------------------------------------- 'chercher dernière cellule 1ère colonne '-------------------------------------- i = 1 Do: i = i + 1: Loop While Cells(i, 1) <> "" derCell1 = i - 1 'chercher dernière cellule 2ème colonne i = 1 Do: i = i + 1: Loop While Cells(i, 2) <> "" derCell2 = i - 1 Range("H14") = derCell1 - 1 Range("H15") = derCell2 - 1 '------------------------------------- 'réinitialiser '------------------------------------- Range("D:F").ClearContents Range("D1").FormulaR1C1 = "=""Seulement dans "" &RC[-3]" Range("E1").Value = "En commun" Range("F1").FormulaR1C1 = "=""Seulement dans "" &RC[-4]" Columns("A:B").Font.Bold = False Range("A1:B1").Font.Bold = True 'chercher commun et seulement gauche Dim trouvé As Boolean For i = 2 To derCell1 trouvé = False For j = 2 To derCell2 If Cells(i, 1) = Cells(j, 2) Then trouvé = True Exit For End If Next If Not trouvé Then ng = ng + 1 Cells(ng + 1, 4) = Cells(i, 1) Cells(i, 1).Font.Bold = True Else nc = nc + 1 Cells(nc + 1, 5) = Cells(i, 1) End If MAJ_compteurs Next 'seulement droite For i = 2 To derCell2 trouvé = False For j = 2 To derCell1 If Cells(i, 2) = Cells(j, 1) Then trouvé = True Exit For End If Next If Not trouvé Then nd = nd + 1 Cells(nd + 1, 6) = Cells(i, 2) Cells(i, 2).Font.Bold = True End If MAJ_compteurs Next MAJ_compteurs 'MsgBox nc & " éléments communs, " & vbCrLf & _ ng & " seulement à gauche," & vbCrLf & _ nd & " seulement à droite." End Sub Private Sub MAJ_compteurs() Static n n = n + 1 If n Mod 20 <> 0 Then Exit Sub Range("H17") = ng Range("H18") = nc Range("H19") = nd Range("I23") = Time Range("I24") = DateDiff("s", Range("I22"), Range("I23")) & " s" End Sub