Comparer deux fichiers

J'ai une liste de noms dans la colonne A d'un classeur 1 et une liste à peu près similaire dans un classeur 2. Je voudrais lire les noms du classeur 1 et savoir s'ils sont dans le classeur 2.

Deux macros : Comparaison et Comparaison1

Comparaison compare chaque ligne de cellule de Liste1 avec chaque cellule de Liste2 et met la cellule de Liste1 en rouge si aucune correspondance n'est trouvée dans Liste2

Comparaison1 ne travaille pas avec des listes, mais avec l'entièreté des
colonnes A de Classeur1 et Classeur2.

Elle est à privilégier pour de grosses listes. On peut évidemment modifier le code de
For each cellule1 in range("a:a:") par for each cellule1 in range("liste1") et faire la même chose pour cellule2 et liste2...

sub Comparaison()
   Application.ScreenUpdating = False
   Dim Cellule1 As Range, Cellule2 As Range
   Dim Time1 As Date, Time2 As Date
   Time1 = Now()
   Workbooks("classeur1.xls").Activate
   For Each Cellule1 In Range("liste1")
     Workbooks("classeur2.xls").Activate
     For Each Cellule2 In Range("liste2")
       If Cellule1 <> Cellule2 Then
        Cellule1.Font.Color = vbRed
       Else
        Cellule1.Font.Color = vbBlack
        Exit For
       End If
   Next Cellule2
     Workbooks("classeur1.xls").Activate
   Next Cellule1
   Time2 = Now()
   Debug.Print "TestListe :" & Format$(Time2 -
   Time1, "hh:mm:ss")
   Application.ScreenUpdating = True
 end sub
sub Comparaison1()
   Application.ScreenUpdating = False
   Dim Collection1 As New Collection, collection2 As New Collection
   Dim Cellule1 As Range, Cellule2 As Range
   Dim Element1 As Object, Element2 As Object
   Dim Time1 As Date, Time2 As Date
   Time1 = Now()
 
 Workbooks("classeur1.xls").Activate
   For Each Cellule1 In Range("a:a")
 
  Collection1.Add Cellule1
   Next Cellule1
 
 Workbooks("classeur2.xls").Activate
   For Each Cellule2 In Range("a:a")
 
  collection2.Add Cellule2
   Next Cellule2
   For Each Element1 In Collection1
     For Each Element2 In collection2
      If Element1 <> Element2 Then
         Element1.Font.Color = vbRed
  Else
         Element1.Font.Color = vbBlack
         Exit For
      End If
     Next Element2
   Next Element1
   Time2 = Now()
 
 Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
 Application.ScreenUpdating = True
 end sub

Auteur :

Mots clefs associés à cette page : , , , , , , , ,