comparer 2 listes et extraire les disparus et les nouveaux

raskok

XLDnaute Junior
Bonjour à tous,
j'ai besoin de votre aide pour arranger une erreur de formule
j'ai quand je clic sur le bouton "comparer" le prénom qui s'affiche à la place du nom si c'est un prénom composé
les 2 prénoms du coup n'apparaissent pas dans la même colonne
cependant la recherche et la comparaison des listes restent bonne
Un internaute m'avait aidé pour le démarrage (que je remercie encore au passage)
j'ai réussi à ajouter la comparaison avec la colonne code, mais cette séparation de prénom me gêne beaucoup
Merci d'avance pour ceux qui se pencheront sur le problème
:D
 

Pièces jointes

  • les disparues 4.xls
    45.5 KB · Affichages: 50
  • les disparues 4.xls
    45.5 KB · Affichages: 52
  • les disparues 4.xls
    45.5 KB · Affichages: 56

fhoest

XLDnaute Accro
Re : comparer 2 listes et extraire les disparus et les nouveaux

Bonjour Raskok ,

Voici une solution:
Code:
Sub compare()
Sheets("Feuil3").Cells.Clear
Set dico = CreateObject("Scripting.dictionary")
For n = 1 To 2
 For m = 1 To Sheets(n).Range("c" & Rows.Count).End(xlUp).Row
   x = Trim(Sheets(n).Range("c" & m)) & " " & Trim(Replace(Sheets(n).Range("b" & m), " ", "_")) & " " & Trim(Sheets(n).Range("a" & m))
   dico(x) = dico(x) & Sheets(n).Name & "!"
 Next
Next
c = dico.keys
b = dico.items
a = dico.items
For n = LBound(c) To UBound(c)
  Sheets("Feuil3").Cells(n + 1, 3) = Split(c(n))(0)
  Sheets("Feuil3").Cells(n + 1, 2) = Split(c(n))(1)
  Sheets("Feuil3").Cells(n + 1, 1) = Split(c(n))(2)
  y = Left(b(n), Len(b(n)) - 1)
  If UBound(Split(y, "!")) > 0 Then
    Sheets("Feuil3").Cells(n + 1, 4) = "commun"
  Else
    If y = Sheets(1).Name Then
      Sheets("Feuil3").Cells(n + 1, 4) = "disparu"
       Sheets("Feuil3").Cells(n + 1, 4).Interior.ColorIndex = 4
    Else
      Sheets("Feuil3").Cells(n + 1, 4) = "nouveau"
       Sheets("Feuil3").Cells(n + 1, 4).Interior.ColorIndex = 5
      End If
  End If
Next
End Sub
A+
 

Discussions similaires