Comparaison de deux fichiers avec synthèse

Question

Tous les mois je reçois une extraction Excel de la forme de celle du tableau joint Je voudrai comparer la feuil 1 avec la feuille 2 sur des colonnes bien précises , faire apparaître dans un tableau de synthèse les lignes qui ont bougé et indiquer les valeurs avant apres, faire apparaître dans la synthèse les lignes supprimées et les nouvelles crées. J'ai essayé de résumer mon besoin dans le dernier onglet du fichier excel joint Merci beaucoup de votre aide...

MFerrand · Answer

Vois si cela correspond... Sub Synthèse() Dim TS(11), col, i%, n%, t%, s% col = Split("AY A G G W W BN BN BO BO BP BP"): s = 4 With Worksheets("Feuil1") n = .Range("A" &amp; .Rows.Count).End(xlUp).Row For i = 2 To n For t = 0 To 11 If t Mod 2 Then TS(t) = Worksheets("Feuil2").Range(col(t) &amp; i) Else TS(t) = .Range(col(t) &amp; i) End If Next t For t = 2 To 10 Step 2 If TS(t) &lt;&gt; TS(t + 1) Then Exit For Next t If t &lt;= 10 Then s = s + 1 Worksheets("Synthèse").Range("A" &amp; s).Resize(, 12).Value = TS End If Erase TS Next i End With End Sub Attention ! ne pas la placer dans le Module1 de ton fichier exemple. Ce dernier est en Option Base 1 ! Je ne travaille jamais avec cette option, on peut dimensionner directement l'indice mini si on diffère de 0, et je trouve que cela présente trop de risques d'erreurs (j'ai d'ailleurs dû chercher un moment d'où venait le problème avant de voir la chose... ) Cordialement...

MFerrand · Answer

Ah j'ai sans doute zappé cette histoire de ligne créées ou supprimées... ?

Mais deux feuilles de 14 lignes chacune, pour moi elles se correspondaient ! J'ai donc fait une comparaison des valeurs demandées ligne par ligne.

Si l'identité des lignes n'est assurée entre les deux feuilles, à ce moment là la technique n'est plus la même : il faut d'abord indiquer un identifiant pour chaque ligne.

A partir de là on commence par trier les deux bases sur cet identifiant avant de procéder aux comparaisons... si une ligne de 1 n'est pas trouvé dans 2, c'est qu'elle a été supprimée, si une ligne de 2 n'est pas dans 1, c'est qu'elle a été créée, et pour les lignes trouvées dans 1 et 2 on compare...

Après si une différence apparaît dans les valeurs indiquées, il était question de signaler la ligne ("qui a bougé") pas d'en éliminer les valeurs non modifiées.

MFerrand · Answer

Macro modifiée pour détecter les suppressions et créations...

Sub Synthèse()
    Dim TS(11), col, i%, n%, n2%, d%, t%, s%, ws2 As Worksheet
    col = Split("AY A G G W W BN BN BO BO BP BP"): s = 4
    Set ws2 = Worksheets("Feuil2")
    n2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    ws2.Range("A1:A" & n2).Resize(, 68).Sort key1:=ws2.Range("A1"), order1:=xlAscending, Header:=xlYes
    With Worksheets("Feuil1")
        n = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("A1:A" & n).Resize(, 68).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
        For i = 2 To n
            If .Cells(i, 1) = ws2.Cells(i + d, 1) Then
                For t = 0 To 11
                    If t Mod 2 Then
                        TS(t) = ws2.Range(col(t) & i + d)
                    Else
                        TS(t) = .Range(col(t) & i)
                    End If
                Next t
                For t = 2 To 10 Step 2
                    If TS(t) <> TS(t + 1) Then Exit For
                Next t
                If t <= 10 Then
                    s = s + 1
                    Worksheets("Synthèse").Range("A" & s).Resize(, 12).Value = TS
                End If
                Erase TS
            ElseIf .Cells(i, 1) < ws2.Cells(i + d, 1) Then
                TS(0) = .Range(col(0) & i)
                TS(1) = .Range(col(1) & i)
                For t = 2 To 10 Step 2
                    TS(t) = .Range(col(t) & i)
                Next t
                s = s + 1
                With Worksheets("Synthèse").Range("A" & s).Resize(, 12)
                    .Value = TS
                    .Interior.Color = vbRed
                End With
                Erase TS: d = d - 1
            ElseIf .Cells(i, 1) > ws2.Cells(i + d, 1) Then
                TS(0) = ws2.Range(col(0) & i + d)
                TS(1) = ws2.Range(col(1) & i + d)
                For t = 3 To 11 Step 2
                    TS(t) = ws2.Range(col(t) & i + d)
                Next t
                s = s + 1
                With Worksheets("Synthèse").Range("A" & s).Resize(, 12)
                    .Value = TS
                    .Interior.Color = vbCyan
                End With
                Erase TS: d = d + 1: i = i - 1
            End If
            If i + d >= n2 Then Exit For
        Next i
        If i > n Then
            If n + d < n2 Then
                For i = n + d + 1 To n2
                    TS(0) = ws2.Range(col(0) & i)
                    TS(1) = ws2.Range(col(1) & i)
                    For t = 3 To 11 Step 2
                        TS(t) = ws2.Range(col(t) & i)
                    Next t
                    s = s + 1
                    With Worksheets("Synthèse").Range("A" & s).Resize(, 12)
                        .Value = TS
                        .Interior.Color = vbCyan
                    End With
                    Erase TS
                Next i
            End If
        Else
            If i < n Then
                For i = i + 1 To n
                    TS(0) = .Range(col(0) & i)
                    TS(1) = .Range(col(1) & i)
                    For t = 2 To 10 Step 2
                        TS(t) = .Range(col(t) & i)
                    Next t
                    s = s + 1
                    With Worksheets("Synthèse").Range("A" & s).Resize(, 12)
                        .Value = TS
                        .Interior.Color = vbRed
                    End With
                    Erase TS
                Next i
            End If
        End If
    End With
End Sub

Mais elle me fournit le même résultat sans détecter aucune création ni suppression.

Es-tu sûr qu'il y en a dans ton exemple ?

MFerrand · Answer

Bon ! A suivre... Si une ligne supprimée est détectée et reproduite, elle doit être colorée en rouge, si créée, colorée en cyan...

MFerrand · Answer

Je mets généralement peu de commentaires (ou pas !) car c'est en principe insuffisant à expliquer et si on met des explications suffisantes, on ne voit plus le code au milieu !! Je te remets donc une version expliquée de la macro : les explications sont concentrées au début (lors des déclarations de variables) et complétées au niveau du test en fin de boucle. Les autres commentaires indiquent où se matérialisent les explications fournies au début. Sub Synthèse() 'Déclarations de variables (selon la façon dont on prévoit d'opérer) : '-un tableau de 12 éléments (0 à 11) pour recueillir une ligne à reproduire dans le tableau ' synthèse, on videra ce tableau à l'issue de chaque test de ligne : TS '-une variable de type Variant (col) que l'on va utiliser pour créer un tableau des colonnes ' à tester sur chaque ligne : les 2 premières auront des valeurs identiques si la ligne existe ' sur les deux feuilles (indices 0 et 1), pour les éléments suivants (2 à 11), les colonnes se ' répètent par couple (correspondant aux situations avant &#91;Feuil1&#93; et après &#91;Feuil2&#93; de la synthèse '-variables Integer n et n2 pour recueillir le numéro de ligne de fin, respectivement sur Feuil1 ' et Feuil2 '-variable compteur (Integer) i sera utilisée pour défiler les lignes de Feuil1 (mais se souvenir ' que des lignes ont pu être supprimées, et d'autres créées dans Feuil2, donc la coincidence de ' Feuil1 avec Feuil2 n'est pas assurée...) '-on va donc faire intervenir une variable (Integer) d supplémentaire pour gérer le décalage ' susceptible d'intervenir entre les lignes de chaque feuille : pour chaque ligne i de Feuil1, la ' ligne correspondante de Feuil2 sera i+d ; les deux feuilles étant triées sur l'identifiant en ' colonne A, tant que les valeurs de cet identifiant sont égales sur les deux feuilles, les lignes ' se correspondent et d=0, s'il n'y a pas égalité, si la valeur en Feuil1 est inférieure, cela veut ' dire que la ligne n'existe plus en Feuil2, donc a été supprimée, on la recueille dans TS (uniquement ' situation 'avant', on l'affecte à Synthèse en colorant la ligne en rouge, on décrémente d (-1) pour ' rétablir la correspondance des lignes ; si la valeur en Feuil1 est supérieure par contre, c'est ' que la ligne en Feuil2 n'existait pas et a donc été créée, on la recueille dans TS (uniquement ' situation 'après', on l'affecte à Synthèse en colorant la ligne en cyan, on incrémente d (+1) pour ' rétablir la correspondance, mais la ligne i n'ayant pas été testée (en raison création intervenue) ' on doit également décrémenter i (-1) pour y repasser '-une autre variable Integer t nous servira à servir le tableau TS, dans le cas du recueil de la même ' ligne sur les deux feuilles, pour les valeurs paires de t (variation de 0 à 11) on prélève sur ' Feuil1, pour les valeurs impaires sur Feuil2 ; quand on ne doit prélever que sur une seule feuille, ' on utilise un pas de 2 sur les valeurs paires ou impaires de t selon le cas (sauf pour les deux ' premières valeurs toujours prélevées sur la feuille concernée) ; &#91;t permet de mettre en correspondance ' les indices du tableau TS et ceux du tableau col pour les prélèvements&#93; '-une dernière variable Integer s est incrémentée à chaque fois qu'une ligne doit être reproduite sur ' Synthèse, pour indiquer la ligne d'inscription '-enfin, comme on va défiler la boucle principale dans Feuil1, on mettra cette feuille sous instruction ' With... End With, et on mémorise Feuil2 dans une variable feuille pour faciliter l'écriture. Dim TS(11), col, i%, n%, n2%, d%, t%, s%, ws2 As Worksheet 'Tableau col et initialisation de s col = Split("AY A G G W W BN BN BO BO BP BP"): s = 4 'Affectation de ws2 Set ws2 = Worksheets("Feuil2") 'Calcul de n2 n2 = ws2.Range("A" &amp; Rows.Count).End(xlUp).Row 'Tri de Feuil2 ws2.Range("A1:A" &amp; n2).Resize(, 68).Sort key1:=ws2.Range("A1"), order1:=xlAscending, Header:=xlYes 'Mémorisation de Feuil1... With Worksheets("Feuil1") 'Calcul de n n = .Range("A" &amp; .Rows.Count).End(xlUp).Row 'Tri de Feuil1 .Range("A1:A" &amp; n).Resize(, 68).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes 'Démarrage de la boucle principale For i = 2 To n 'Cas égalité des valeurs en A de Feuil1 et Feuil2 (on va comparer) If .Cells(i, 1) = ws2.Cells(i + d, 1) Then 'Boucle secondaire pour servir TS For t = 0 To 11 If t Mod 2 Then TS(t) = ws2.Range(col(t) &amp; i + d) Else TS(t) = .Range(col(t) &amp; i) End If Next t 'Comparaison des valeurs 'avant' et 'après' (on sort de cette nouvelle boucle ' secondaire dès qu'une différence apparaît) For t = 2 To 10 Step 2 If TS(t) &lt;&gt; TS(t + 1) Then Exit For Next t 'On teste la sortie de boucle (si pas de différence, t aura la valeur 12...) ' si différence on incrémente s et on affecte TS... If t &lt;= 10 Then s = s + 1 Worksheets("Synthèse").Range("A" &amp; s).Resize(, 12).Value = TS End If 'Vidage de TS pour le tour suivant Erase TS 'Cas valeur Feuil1 en A inférieure à Feuil2 (la ligne Feuil1 a été supprimée) ElseIf .Cells(i, 1) &lt; ws2.Cells(i + d, 1) Then 'Affectation à TS (2 premières valeurs et valeurs 'avant') TS(0) = .Range(col(0) &amp; i) TS(1) = .Range(col(1) &amp; i) For t = 2 To 10 Step 2 TS(t) = .Range(col(t) &amp; i) Next t 'Incrémentation de s et affectation de TS (et coloration ligne en rouge) s = s + 1 With Worksheets("Synthèse").Range("A" &amp; s).Resize(, 12) .Value = TS .Interior.Color = vbRed End With 'Vidage TS et décrémentation de d Erase TS: d = d - 1 'Cas valeur Feuil1 en A supérieure à Feuil2 (la ligne Feuil2 a été créée) ElseIf .Cells(i, 1) &gt; ws2.Cells(i + d, 1) Then 'Affection à TS (2 premières valeurs et valeurs 'après') TS(0) = ws2.Range(col(0) &amp; i + d) TS(1) = ws2.Range(col(1) &amp; i + d) For t = 3 To 11 Step 2 TS(t) = ws2.Range(col(t) &amp; i + d) Next t 'Incrémentation de s et affectation de TS (et coloration ligne en cyan) s = s + 1 With Worksheets("Synthèse").Range("A" &amp; s).Resize(, 12) .Value = TS .Interior.Color = vbCyan End With 'Vidage TS et incrémentation de d, et décrémentation de i Erase TS: d = d + 1: i = i - 1 End If 'Test à la fin de chaque tour de la boucle principale : la boucle se déroule de 2 à n (lignes ' de Feuil1 existantes) mais si n2 (lignes de Feuil2) se trouve inférieur à un moment à i+d ' (ligne atteinte en Feuil1 en tenant compte du décalage provoqué par les créations-suppr.) ' l'incrémentation de i n'aurait plus de ligne en regard en Feuil2, ce qui génèrerait une ' erreur, on sort donc de la boucle principale avant d'atteindre n dans ce cas. If i + d &gt;= n2 Then Exit For Next i 'En sortie de boucle, soit on n'a pas atteint n et il reste des lignes en Feuil1 qui sont alors ' des suppressions &#91;cas de sortie vu ci-dessus&#93;, soit on l'a atteint et on est sorti normalement ' de la boucle, i est alors =n+1 (puisqu'incrémenté en sortie) et il peut rester des lignes ' non testées en Feuil2 qui sont alors des créations. 'On teste si sortie normale... If i &gt; n Then ' et dans ce cas si n2 est supérieur au niveau n+d atteint avec la boucle... If n + d &lt; n2 Then ' si c'est le cas on prélève les lignes restantes de Feuil2 pour les reporter en créations For i = n + d + 1 To n2 TS(0) = ws2.Range(col(0) &amp; i) TS(1) = ws2.Range(col(1) &amp; i) For t = 3 To 11 Step 2 TS(t) = ws2.Range(col(t) &amp; i) Next t s = s + 1 With Worksheets("Synthèse").Range("A" &amp; s).Resize(, 12) .Value = TS .Interior.Color = vbCyan End With Erase TS Next i End If Else 'Sinon on est sorti de la boucle avant incrémentation de fin en sortie normale et on teste ' si des lignes restent à considérer en Feuil1... If i &lt; n Then ' si c'est le cas, on prélève ces lignes pour les reporter en suppressions For i = i + 1 To n TS(0) = .Range(col(0) &amp; i) TS(1) = .Range(col(1) &amp; i) For t = 2 To 10 Step 2 TS(t) = .Range(col(t) &amp; i) Next t s = s + 1 With Worksheets("Synthèse").Range("A" &amp; s).Resize(, 12) .Value = TS .Interior.Color = vbRed End With Erase TS Next i End If End If End With End Sub Cordialement...