Recherche cellule identique entre deux feuilles + info

[heparti]

Bonjour,

Je souhaite qu'une comparaison se fasse entre deux feuilles du même document excel qui se trouve dans la colonne D de chaque feuille.

Après comparaison et recherche, il faudrait qu'un message "nouveau" s'affiche en colonne K de la feuille 'ajout'.

De la même façon, il faudrait que les lignes de la feuille 'base' (recherchées en colonne D) et qui ne sont plus dans la feuille 'ajout', soient reportées en bas de la feuille 'ajout' en une couleur différente (rouge par exemple).

Merci pour votre aide.

 

[sousou]

Re : Recherche cellule identique entre deux feuilles + info

Bonjour
Regarde si cette solution t'inspire et surtout si j'ai compris!

 

[heparti]

Re : Recherche cellule identique entre deux feuilles + info

Merci sousou pour la macro, elle fonctionne en partie concernant les 'nouveaux'.

Concernant ceux qui ne sont plus dans 'ajout' par rapport à 'base', il n'y a qu'une seule ligne qui s'affiche en dernière ligne alors que je souhaite que l'intégralité des manquants soient listés.

 

[sousou]

Re : Recherche cellule identique entre deux feuilles + info

Bonjour
Il me semble qu'il n'y a qu'une ligne qui se trouve dans base et qui a disparue d'ajout
c'est la 2223334
?

 

[heparti]

Re : Recherche cellule identique entre deux feuilles + info

Bonsoir,

J'ai fait différents tests et même lorsqu'il manque plusieurs lignes une seule est reportée.

De plus, j'ai testé en conditions réelles sur un fichier de plusieurs milliers de lignes, et la macro, même après + de 30 minutes, elle n'avait pas terminé.

Est-ce normal ?

 

[sousou]

Re : Recherche cellule identique entre deux feuilles + info

Bonjour
Ok pour le nombre de ligne, ci- dessous la modif

Pour la longueur il faudrait voir ton fichier et le nombre de ligne concernées
La macro ne s'arrete pas, mais ou en est t'elle?


Sub rech()

Set zoneb = Sheets("base").UsedRange.Columns(4).Rows
Set zonea = Sheets("ajout").UsedRange.Columns(4).Rows
fzonea = Sheets("ajout").UsedRange.Rows.Count
n = 1
For Each i In zoneb
Set r = zonea.Find(i)

If r Is Nothing Then
i.EntireRow.Copy (Sheets("ajout").Rows(fzonea + n))
Sheets("ajout").Rows(fzonea + n).EntireRow.Interior.ColorIndex = 5
n = n + 1
End If
Next

For Each i In zonea
Set r = zoneb.Find(i)
If r Is Nothing Then
i.Offset(0, 7) = "Nouveau"

End If
Next


End Sub

 

[heparti]

Re : Recherche cellule identique entre deux feuilles + info

merci sousou, tout est désormais fonctionnel et m'est d'un très grand secours au quotidien

désolé pour le retard de réponse, j'avais quelques problèmes.

bonne soirée.