XL 2010 Comparer plusieur colonne et ajouter les noms manquant

creolia

XLDnaute Impliqué
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
 

Pièces jointes

  • essais3.xlsx
    9 KB · Affichages: 50

creolia

XLDnaute Impliqué
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

XLDnaute Barbatruc
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 :
Code:
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

XLDnaute Barbatruc
Re,

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

Placez dans le code de la 3ème feuille :
Code:
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+
 
Dernière édition:

creolia

XLDnaute Impliqué
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
 

Pièces jointes

  • Essais4.xlsm
    25.2 KB · Affichages: 50

mapomme

XLDnaute Barbatruc
Supporter XLD
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.
 
Dernière édition:

job75

XLDnaute Barbatruc
Re,

Pour la question des couleurs, cette macro les conserve dans la 3ème feuille :
Code:
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+
 
Dernière édition:

job75

XLDnaute Barbatruc
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.
 
Dernière édition:

creolia

XLDnaute Impliqué
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
 

Discussions similaires

Réponses
12
Affichages
603

Statistiques des forums

Discussions
312 885
Messages
2 093 256
Membres
105 658
dernier inscrit
Mario Richard