Comparer deux onglets dans un fichier + extraction des differences dans un autre onglet

didinelfange

XLDnaute Nouveau
Bonjour tout le petit monde,

Ma macro touche à sa fin, mais je sollicite encore votre matière grise pour la perfectionner.
En effet, dans un fichier récapitulatif, j'ai à présent chaque extraction dans un onglet renommé à la date du jour de l'extraction. Chaque nouvel onglet est copié avant feuil1 .
Je souhaiterai pouvoir créer un troisième onglet comparant les 2 derniers tableaux extraits et reporter uniquement les lignes DIFFÉRENTES entre ces deux tableaux dans ce dernier onglet.
Par ailleurs à chaque fois, que l'on rajoute un user, il se classe par ordre alphabétique (donc je ne peux pas faire de correspondances de lignes)

Je vous remercie par avance de vos réponses . Bonne journée .:)
 

Pièces jointes

  • exemple.xlsm
    13.8 KB · Affichages: 72

Modeste geedee

XLDnaute Barbatruc
Bonsour®
Bonjour tout le petit monde,

Ma macro touche à sa fin, mais je sollicite encore votre matière grise pour la perfectionner.
En effet, dans un fichier récapitulatif, j'ai à présent chaque extraction dans un onglet renommé à la date du jour de l'extraction. Chaque nouvel onglet est copié avant feuil1 .
Je souhaiterai pouvoir créer un troisième onglet comparant les 2 derniers tableaux extraits et reporter uniquement les lignes DIFFÉRENTES entre ces deux tableaux dans ce dernier onglet.
Par ailleurs à chaque fois, que l'on rajoute un user, il se classe par ordre alphabétique (donc je ne peux pas faire de correspondances de lignes)

Je vous remercie par avance de vos réponses . Bonne journée .:)
:cool:
voir là peut-etre :
http://www.ableowl.com/Genie/Download/AddIn.aspx
 

Paf

XLDnaute Barbatruc
bonjour didinelfange, Hieu,Ce lien n'existe plus

un essai macro à tester et adapter
VB:
Sub DiffUser()
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
Dim i As Long, j As Long, Tablo1, Tablo2, TabFin, Dico1, Dico2, Ident As Boolean
Set Dico1 = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")

Set WS1 = Worksheets(1)
Set WS2 = Worksheets(2)
Set WS3 = Worksheets(3)
Tablo1 = WS1.Range("A3:Q" & WS1.Range("A" & Rows.Count).End(xlUp).Row)
Tablo2 = WS2.Range("A3:Q" & WS2.Range("A" & Rows.Count).End(xlUp).Row)

For i = LBound(Tablo1) To UBound(Tablo1)
    Dico1(Tablo1(i, 1)) = Application.Index(Tablo1, i)
Next
For i = LBound(Tablo2) To UBound(Tablo2)
    Dico2(Tablo2(i, 1)) = Application.Index(Tablo2, i)
Next

For i = LBound(Tablo1) To UBound(Tablo1)
    Ident = True
    If Dico2.exists(Tablo1(i, 1)) Then
        For j = 1 To UBound(Dico1(Tablo1(i, 1)))
            If Dico1(Tablo1(i, 1))(j) <> Dico2(Tablo1(i, 1))(j) Then
                Ident = False
                Exit For
            End If
        Next
        If Ident Then
            Dico1.Remove (Tablo1(i, 1))
            Dico2.Remove (Tablo1(i, 1))
        End If
    Else
        Dico2(Tablo1(i, 1)) = Application.Index(Tablo1, i)
    End If

Next
If Dico2.Count > 0 Then
    With WS3.Range("A3")
    .Resize(Dico2.Count, 17) = Application.Transpose(Application.Transpose(Dico2.items))
    .Resize(Dico2.Count, 17).Borders.Value = 1
    .Offset(Dico2.Count + 1, 0) = "Nb total différences ="
    .Offset(Dico2.Count + 1, 3) = Application.CountA(WS3.Range("B3:Q" & Dico2.Count + 2))
    End With
End If
End Sub

s'il y a différences entre même User les données de la feuille extract02 sont affichées
si un User n'existe qu'en feuille extract01 il apparaitra dans les différences
si un User n'existe qu'en feuille extract02 il apparaitra dans les différences

A+



 

didinelfange

XLDnaute Nouveau
bonjour le forum et merci à vous trois pour vos réponses. J'ai appliqué la macro de Paf, qui a l'air de fonctionner.
En revanche, lorsque je pars d'une page vierge je n'ai plus mes en têtes de colonnes qui me permettent de situer où se trouve la différence. Par ailleurs, y a t-il un moyen de séparer les éléments supprimés entre le 01 et le 02 et ceux qui ont été rajoutés entre le 01 et 02 (quitte à faire deux feuilles).
Enfin, si entre 2 extractions un service disparait ou est ajouté puis-je le voir ?
Je vous remercie d'avance de votre réponse et mille mercis pour votre patience.
Je vous joins le fichier .
 

Pièces jointes

  • exemple.xlsm
    14.6 KB · Affichages: 83

Paf

XLDnaute Barbatruc
Re,

pour les entêtes de colonnes, rajouter : WS1.Range("A1:Q2").Copy WS3.Range("A1")
juste après If Dico2.Count > 0 Then

quant aux services qui peuvent apparaître ou disparaître, le code compare les deux feuilles à positions identiques, sans tenir compte des intitulés de colonnes, et là, je ne suis pas assez 'affûté' pour modifier mon code ou construire un code adapté.

Bonne suite
 

didinelfange

XLDnaute Nouveau
Rebonjour le forum ,

Je suis revenue après une longue période d'absence (rupture de contrat et vacances) . Je tenais à vous remercier car ma macro est terminée et elle marche au poil . Mille mercis pour votre aide. Je rouvre un sujet pour une dernière manip que je n'arrive pas à faire mais je peux clôturer celui ci .
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 370
Messages
2 087 693
Membres
103 641
dernier inscrit
anouarkecita2