comparer 2 listes et extraire les disparus et les nouveaux

[raskok]

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

 

[fhoest]

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

Bonjour Raskok ,

Voici une solution:

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+

 

[raskok]

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

Merci, un détail mais qui m'a pris la tête...

Encore un grand merci pour ta rapidité, c'est chouette