XL 2010 Comparer plusieur colonne et ajouter les noms manquant

[creolia]

Bonjour au forum

pouvez vous m'aider svp

J'ai 3 feuille dans chacune des feuilles en Collone A une liste 1,2,3

Je souhaiterais une macro qui compare les 3 listes et incrémenter la 3eme listes par les noms présent autant dans la liste 1 et 2

comment puis je faire svp merci

 

[mapomme]

Bonjour creolia,

Voir un essai en VBA dans le fichier joint. La macro est dans le module de la feuille Feuil1.

 

[creolia]

Bonjour Ma pomme
merci pour ton aide c'est ce que j'essayais de faire sauf que mon fichier d'origine comme je le précisais est sur 3 feuil différent chaque liste etant en colonne A mais la liste 1 est en feuil1 la liste2 en feuil2 et la liste3 en feuil3 tous les 3 en collone A

est ce que ta macro est faisable avec ce type de configuration merci d'avance

 

[job75]

Bonjour creolia, mapomme,

La question n'est pas bien claire.

Je suppose qu'il y a des listes dans les colonnes A et B de chaque feuille, alors placez dans ThisWorkbook :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Sh.[A:B]) Is Nothing Then Exit Sub
Dim t, d1 As Object, d2 As Object, i&, rest(), e
t = Sh.[A1].CurrentRegion.Resize(, 3) 'matrice, plus rapide
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
  If t(i, 1) <> "" Then d1(t(i, 1)) = ""
  If t(i, 2) <> "" Then d2(t(i, 2)) = ""
Next
ReDim rest(1 To UBound(t), 1 To 1)
i = 1
rest(1, 1) = t(1, 3) 'titre
If d1.Count Then
  For Each e In d1.keys
    If d2.exists(e) Then i = i + 1: rest(i, 1) = e
  Next
End If
Sh.[C1].Resize(UBound(rest)) = rest
End Sub

La liste en colonne C se (re)crée chaque fois qu'on valide une donnée en colonne A ou B.

C'est très rapide car on utilise des Dictionary et des tableaux VBA.

A+

 

[job75]

Re,

Je n'avais pas vu le post #3, maintenant c'est clair.

Placez dans le code de la 3ème feuille :

Private Sub WorkSheet_Activate()
'Feuil1 et Feuil2 sont les CodeNames des 2 feuilles sources
Dim d1 As Object, d2 As Object, t, i&, rest(), e
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
t = Feuil1.[A1].CurrentRegion.Resize(, 2) 'au moins 2 éléments
For i = 2 To UBound(t)
  If t(i, 1) <> "" Then d1(t(i, 1)) = ""
Next
t = Feuil2.[A1].CurrentRegion.Resize(, 2) 'au moins 2 éléments
For i = 2 To UBound(t)
  If t(i, 1) <> "" Then d2(t(i, 1)) = ""
Next
ReDim rest(1 To Application.Max(1 + d1.Count, [A1].CurrentRegion.Rows.Count), 1 To 1)
i = 1
rest(1, 1) = [A1] 'titre
If d1.Count Then
  For Each e In d1.keys
    If d2.exists(e) Then i = i + 1: rest(i, 1) = e
  Next
End If
[A1].Resize(UBound(rest)) = rest
With Me.UsedRange: End With 'actualise la barre de défilement verticale
End Sub

La macro se déclenche quand on active la feuille.

A+

 

[creolia]

Bonjour Jobs merci pour ton aide et ta macro juste un petit soucis tout fonctionne bien mais quand je retire un des noms dans ma liste en feuil1 la cellule s'efface bien le problème c'est que ma cellule colorier ne nuis pas le bon nom exemple que j ai mis nom2 est colorier en jaune dans la feuil3 si j’enlève nom0 en feuil1 et que je lance la macro c'est plus nom2 qui est colorier en jaune mais Nom3 comment je peut faire pour que le format de la cellule suis le nom colorier lors de la suppression svp merci

 

[job75]

Re,

Ma macro du post #5 a été corrigée depuis que vous l'avez copiée, prenez la bonne version.

On peut conserver des couleurs en 3ème feuille mais c'est plus compliqué (et lourd).

A+

 

[mapomme]

Bonjour creolia,

Bonjour Ma pomme
merci pour ton aide c'est ce que j'essayais de faire sauf que mon fichier d'origine comme je le précisais est sur 3 feuil différent chaque liste etant en colonne A mais la liste 1 est en feuil1 la liste2 en feuil2 et la liste3 en feuil3 tous les 3 en collone A

est ce que ta macro est faisable avec ce type de configuration merci d'avance

D'où l'utilité de joindre un exemple représentatif ! Votre premier fichier comportait 3 listes sur Feuil1 et rien sur les Feuil2 et Feuil3.
job75 (que je salue ) a répondu à votre souhait.

 

[job75]

Re,

Pour la question des couleurs, cette macro les conserve dans la 3ème feuille :

Private Sub WorkSheet_Activate()
'Feuil1 et Feuil2 sont les CodeNames des 2 feuilles sources
Dim d1 As Object, d2 As Object, t, i&, rest(), e, P As Range
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
t = Feuil1.[A1].CurrentRegion.Resize(, 2) 'au moins 2 éléments
For i = 2 To UBound(t)
  If t(i, 1) <> "" Then d1(t(i, 1)) = ""
Next
t = Feuil2.[A1].CurrentRegion.Resize(, 2) 'au moins 2 éléments
For i = 2 To UBound(t)
  If t(i, 1) <> "" Then d2(t(i, 1)) = ""
Next
ReDim rest(1 To Application.Max(1 + d1.Count, [A1].CurrentRegion.Rows.Count), 1 To 1)
i = 1
rest(1, 1) = [A1] 'titre
If d1.Count Then
  For Each e In d1.keys
    If d2.exists(e) Then i = i + 1: rest(i, 1) = e
  Next
End If
'---mémorisation des couleurs---
Set P = [A1].CurrentRegion.Resize(, 1)
t = P.Resize(, 2) 'au moins 2 éléments
d1.RemoveAll
For i = 1 To UBound(t)
  If t(i, 1) <> "" Then
  With P(i).Interior
  If .ColorIndex <> xlNone Then d1(t(i, 1)) = .Color
  End With
  End If
Next
'---restitution des valeurs et couleurs---
Application.ScreenUpdating = False
Set P = P.Resize(UBound(rest))
P = rest
P.EntireColumn.Interior.ColorIndex = xlNone 'RAZ
For i = 1 To UBound(rest)
  If d1.exists(rest(i, 1)) Then P(i).Interior.Color = d1(rest(i, 1))
Next
'---bordures---
P.EntireColumn.Borders.LineStyle = xlNone 'RAZ
[A1].CurrentRegion.Resize(, 1).Borders.Weight = xlThin
With Me.UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Attention, quand vous supprimez un nom il ne faut pas seulement l'effacer, il faut supprimer sa ligne.

En effet mes macros utilisant .CurrenRegion il ne faut pas de cellules vides dans les 3 tableaux.

Edit : j'ai ajouté les bordures dans la 3ème feuille.

A+

 

[creolia]

Re bonjour à vous desoler ma pomme il est vrais mes explication ainsi que le fichier manquais de précision job75 un grand merci c'est parfait c'est vraiment formidable je vais m'atteler à l'adapter bonne soirée et encore merci à vous deux

 

[job75]

Bonjour creolia, mapomme, le forum,

Je viens d'ajouter des bordures dans la macro précédente.

Et j'ai testé sur 3 tableaux identiques de 50 000 noms sans doublon, résultats sur Win 10 - Excel 2013 :

- sans cellules colorées en 3ème feuille => 1,9 seconde

- toutes les cellules colorées => 4,3 secondes.

Edit : si l'on neutralise tout ce qui concerne les couleurs => 1,04 seconde.

Bonne journée.

 

[creolia]

re bonjour c'est super un grand merci

 

[creolia]

SVP petite question si je veux limite la plage de nom à 34 lignes pour la feuil3 peut tu me dire ou je doit modifier svp ayant des donner autre en dessous de ses lignes j'aimerais limiter ma liste à 34 lignes et comme j'ai cru comprendre que la macro fait une recherche de la derniere ligne renseigner par le bas sa me poserais quelque probleme je pense merci