XL 2016 Comparer deux colonnes et aligner - Bilan

pilotdankevin · 7 Septembre 2020

Bonjour à tous,

J'ai besoin de votre aide car j'essaye de comparer deux bilans comptable sur Excel.

En fait, je possède deux bilan (donc deux tableaux), mais avec un nombre d'entrées qui varie.

C'est à dire que dans un bilan j'ai 1000 lignes et dans l'autre 1200 par exemple... La plupart des entrées sont similaires, mais dans un bilan on peut avoir des lignes qui ne sont pas dans l'autre, et inversement... . Il n'y a donc pas le même nombre de lignes, et pour comparer ces bilans je ne peux donc pas les mettre côte à côte : il y a un décalage.

Il me faut un moyen pour aligner le tout afin de le rendre comparable. Cela paraît simple, mais je ne parviens pas à trouver la solution.

J'ai joint un exemple simplifié (mes données réelles sont sur 1000lignes++), avec Bilan 1 et Bilan 2 en source, qui donne un bilan comparatif dans la feuille 'JE VEUX ÇA'

Merci à tous

PS : J'ai trouvé cette discussion mais cela ne semble pas être la bonne solution .. https://www.excel-downloads.com/threads/aligner-des-donnees.168401/

job75 · 13 Octobre 2020

Bonjour pilotdankevin, le forum,

Il y avait encore un problème quand le 1er élément de Bilan 2 n'existe pas dans Bilan 1.

Testez le fichier du post #24 en remplaçant Element 1 par Element 0 dans Bilan 2.

C'est dû au fait que lig = 1, pour y remédier j'ai ajouté dans ce fichier (3) :

VB:

            If lig = 1 And n Then
                .Cells(2).Resize(n, 2 * ncol + 1) = resu 'décale l'existant d'une ligne
                .Resize(, 2 * ncol + 1) = "" 'vide la ligne 1
            End If

A+

pilotdankevin · 24 Septembre 2020

Parfait ! Je commence à comprendre comment vous faites,

Je vais essayer d'adapter, j'ai 8 colonnes à comparer, et je vais essayer de mettre les colonnes correspondantes côtes à côtes pour une meilleure lecture,

Je reviens vers vous pour vous dire si j'y parviens,

Merci encore,

job75 · 24 Septembre 2020

pilotdankevin à dit:
Je vais essayer d'adapter, j'ai 8 colonnes à comparer, et je vais essayer de mettre les colonnes correspondantes côtes à côtes pour une meilleure lecture,

Ce n'est pas très facile, voyez ce fichier (4) qui fonctionne quel que soit le nombre de colonnes :

VB:

Private Sub Worksheet_Activate()
Dim ncol%, d1 As Object, d2 As Object, resu(), tablo, i&, n&, x$, j%, y$, lig&, c As Range
ncol = 8 'nombre de colonnes à comparer, à adapter
Set d1 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
Set d2 = CreateObject("Scripting.Dictionary")
d2.CompareMode = vbTextCompare 'la casse est ignorée
ReDim resu(1 To Rows.Count, 1 To 2 * ncol + 1)
tablo = Feuil1.[B2].CurrentRegion.Resize(, ncol + 1) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    n = n + 1
    x = Trim(tablo(i, 1))
    resu(n, 1) = x
    For j = 2 To ncol + 1: resu(n, 2 * j - 2) = tablo(i, j): Next
    d1(x) = d1(x) + 1 'compte
    d2(x & Chr(1) & d1(x)) = n 'repère la ligne
Next
tablo = Feuil2.[B2].CurrentRegion.Resize(, ncol + 2) 'matrice, plus rapide, 1 colonne de plus pour le repérage
d1.RemoveAll 'RAZ
For i = 2 To UBound(tablo)
    x = Trim(tablo(i, 1))
    d1(x) = d1(x) + 1 'compte
    y = x & Chr(1) & d1(x)
    If d2.exists(y) Then
        lig = d2(y)
        For j = 2 To ncol + 1: resu(lig, 2 * j - 1) = tablo(i, j): Next
        tablo(i, ncol + 2) = lig 'repère le numéro de ligne
    Else
        tablo(i, ncol + 2) = ""
    End If
Next
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [B3] '1ère cellule de restitution, à adapter
    If n Then .Resize(n, 2 * ncol + 1) = resu
    .Resize(Rows.Count - .Row + 1, 2 * ncol + 1).Font.Bold = False 'non gras
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2 * ncol + 1).ClearContents 'RAZ en dessous
    '---insertion des lignes du 2ème bilan non traitées---
    For i = 2 To UBound(tablo)
        If tablo(i, ncol + 2) = "" Then
            lig = Val(tablo(i - 1, ncol + 2)) + 1
            If lig > 1 Then .Cells(lig, 1).Resize(, 2 * ncol + 1).Insert xlDown
            For j = 1 To ncol + 1: .Cells(lig, 2 * j - 1) = tablo(i, j): Next
            tablo(i, ncol + 2) = lig 'repère le numéro de ligne
            n = n + 1
        End If
    Next
    '---traitement de la ligne Bilan---
    If n Then Set c = .Resize(n).Find("Bilan", , xlValues, xlWhole)
    If Not c Is Nothing Then
        c.Resize(, 5).Cut
        .Offset(n).Insert
        .Offset(n - 1).Font.Bold = True 'gras
    End If
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub

pilotdankevin · 25 Septembre 2020

Cette solution marche super bien !

Je reviens vers vous si j'ai d'autres questions mais là tout est ok et fonctionne parfaitement,

Merci bcp encore

pilotdankevin · 30 Septembre 2020

Bonjour @job75

Après vérification et divers tests, je suis face à un pb avec la solution actuelle ...

Je ne comprends pas vraiment comment la macro fonctionne, mais j'ai des lignes se retrouvent insérées au mauvais endroit & d'autres ne se retrouvent pas insérées du tout.

J'ai l'impression que la macro insère dès que il n'y a plus de similarité. Mais du coup cela induit des lignes insérées au mauvais endroit. Typiquement, des lignes en plus du bilan 2 se retrouvent effectivement insérées, mais quelques lignes (4/5) trop haut dans le bilan, donc pas au bon endroit par rapport aux sous totaux. D'autres ne se retrouvent pas insérées du tout.

Je ne comprends pas comment je peux solutionner cela. Il faudrait un comparatif ligne par ligne ?

En espérant bien expliquer le problème,

Merci

klin89 · 2 Octobre 2020

Bonsoir à tous,

Dans ton cas, il serait judicieux d'insérer une ligne blanche sous chaque total.
On pourrait comparer chaque bloc de Bilan N avec ceux de Bilan N-1 à l'aide de la propriété Areas
pour matcher les correspondances.
Cela serait beaucoup plus simple.

Je ne peux pas t'aider, je n'ai pas VBA sous la main, mais suiverais avec intérêt cette discussion.

klin89

pilotdankevin · 6 Octobre 2020

Bonsoir,

@klin89 Je vois ce que tu veux dire pour les blocs. Effectivement, cela résoudrait peut-être le problème restant. Comme expliqué, tout fonctionne il reste simplement quelques lignes qui se retrouvent au mauvais endroit, sans incidence sur les sous totaux ou autres lignes.

Par contre, je ne vois pas du tout comment appliquer cette idée à la solution de job75, je ne sais pas si il est possible d'y inclure Areas ?

Dan

job75 · 6 Octobre 2020

Bonjour pilotdankevin, klin89,

Sans fichier joint représentatif du problème posé au post #19 on parle dans le vide.

A+

pilotdankevin · 8 Octobre 2020

Bonjour,

Voici une représentation de ce qui se passe lors du traitement de mes bilans comptable par la macro.

Les éléments similaires et sous totaux similaires s'alignent parfaitement. Les bonnes valeurs sont reportées. Néanmoins, parfois, certains éléments se retrouvent remontés avant le mauvais sous total dans mon comparatif. Il faut bien comprendre qu'aucun total/ valeur n'est changé et que cela n'affecte pas les autres éléments qui sont bien reportés et alignés.

C'est simplement que des éléments/ lignes ne se retrouvent parfois au mauvais endroit.

Cela affecte la lisibilité du doc, et la macro n'est pas restituable car d'un point de vue financier, c'est incorrect.

J'ai beau retourner la macro dans tous les sens je ne comprends pas ce qu'il faudrait changer. Pour moi, elle traite ligne par ligne donc je ne comprends pas pourquoi cela arrive.

Comment pourrais-je m'y prendre ?

Merci !!

Dan-Kevin

job75 · 8 Octobre 2020

Bonjour pilotdankevin,

J'ai trouvé ce qui clochait dans ma macro du post #17.

Puisqu'on insère des lignes il faut incrémenter les repères des lignes en dessous :

VB:

            For k = i + 1 To UBound(tablo)
                If tablo(k, ncol + 2) <> "" Then tablo(k, ncol + 2) = tablo(k, ncol + 2) + 1 'incrémente le repère
            Next k

Vous pouvez donc maintenant utiliser cette macro et tester le fichier joint :

VB:

Private Sub Worksheet_Activate()
Dim ncol%, d1 As Object, d2 As Object, resu(), tablo, i&, n&, x$, j%, y$, lig&, k&, c As Range
ncol = 1 'nombre de colonnes à comparer, à adapter
Set d1 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
Set d2 = CreateObject("Scripting.Dictionary")
d2.CompareMode = vbTextCompare 'la casse est ignorée
ReDim resu(1 To Rows.Count, 1 To 2 * ncol + 1)
tablo = Feuil1.[B2].CurrentRegion.Resize(, ncol + 1) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    n = n + 1
    x = Trim(tablo(i, 1))
    resu(n, 1) = x
    For j = 2 To ncol + 1: resu(n, 2 * j - 2) = tablo(i, j): Next
    d1(x) = d1(x) + 1 'compte
    d2(x & Chr(1) & d1(x)) = n 'repère la ligne
Next i
tablo = Feuil2.[B2].CurrentRegion.Resize(, ncol + 2) 'matrice, plus rapide, 1 colonne de plus pour le repérage
d1.RemoveAll 'RAZ
For i = 2 To UBound(tablo)
    x = Trim(tablo(i, 1))
    d1(x) = d1(x) + 1 'compte
    y = x & Chr(1) & d1(x)
    If d2.exists(y) Then
        lig = d2(y)
        For j = 2 To ncol + 1: resu(lig, 2 * j - 1) = tablo(i, j): Next j
        tablo(i, ncol + 2) = lig 'repère le numéro de ligne
    Else
        tablo(i, ncol + 2) = ""
    End If
Next i
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [B5] '1ère cellule de restitution, à adapter
    If n Then .Resize(n, 2 * ncol + 1) = resu
    .Resize(Rows.Count - .Row + 1, 2 * ncol + 1).Font.Bold = False 'non gras
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2 * ncol + 1).ClearContents 'RAZ en dessous
    '---insertion des lignes du 2ème bilan non traitées---
    For i = 2 To UBound(tablo)
        If tablo(i, ncol + 2) = "" Then
            lig = Val(tablo(i - 1, ncol + 2)) + 1
            If lig > 1 Then .Cells(lig, 1).Resize(, 2 * ncol + 1).Insert xlDown
            For j = 1 To ncol + 1: .Cells(lig, 2 * j - 1) = tablo(i, j): Next j
            For k = i + 1 To UBound(tablo)
                If tablo(k, ncol + 2) <> "" Then tablo(k, ncol + 2) = tablo(k, ncol + 2) + 1 'incrémente les repères en dessous
            Next k
            tablo(i, ncol + 2) = lig 'repère le numéro de ligne
            n = n + 1
        End If
    Next i
    '---traitement de la ligne Bilan---
    If n Then Set c = .Resize(n).Find("Bilan", , xlValues, xlWhole)
    If Not c Is Nothing Then
        c.Resize(, 5).Cut
        .Offset(n).Insert
        .Offset(n - 1).Font.Bold = True 'gras
    End If
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub

Les éléments ne sont pas dans l'ordre que vous souhaitez mais ça n'a aucune importance.

A+

job75 · 9 Octobre 2020

Notez que si l'on veut obtenir les éléments dans l'ordre souhaité il suffit de traiter d'abord Bilan 2 et ensuite Bilan 1, fichier (2).

pilotdankevin · 12 Octobre 2020

Bonjour,

Après vérification, cela à l'air de fonctionner parfaitement ! Je vais vérifier en détail sur divers docs mais je ne vois aucun autre problème pour le moment.

Je vous tiens au courant lorsque j'aurais transmis mon doc. Merci bcp Job75 pour votre aide et les modifications. C'était mon premier post, ce forum est génial

Dan-Kevin

job75 · 13 Octobre 2020

Bonjour pilotdankevin, le forum,

Il y avait encore un problème quand le 1er élément de Bilan 2 n'existe pas dans Bilan 1.

Testez le fichier du post #24 en remplaçant Element 1 par Element 0 dans Bilan 2.

C'est dû au fait que lig = 1, pour y remédier j'ai ajouté dans ce fichier (3) :

VB:

            If lig = 1 And n Then
                .Cells(2).Resize(n, 2 * ncol + 1) = resu 'décale l'existant d'une ligne
                .Resize(, 2 * ncol + 1) = "" 'vide la ligne 1
            End If

A+

pilotdankevin · 13 Octobre 2020

Je viens de tester avec le code du fichier que j'ai réussi à ouvrir,

Quand la première ligne de Bilan 2 est différente cela ne fonctionne toujours pas....

La macro insère bien le nom de la ligne présent dans le bilan 2, mais elle y met la première valeur de bilan 1 (qui correspond à une ligne différente).

C'est la même erreur qui apparait avec la macro précédente.

job75 · 13 Octobre 2020

pilotdankevin à dit:
Quand la première ligne de Bilan 2 est différente cela ne fonctionne toujours pas....

Chez moi le fichier du post #27 fonctionne bien, joignez le fichier que vous avez utilisé.

pilotdankevin · 13 Octobre 2020

Ce sont des documents internes je ne peux pas. J'ai des problèmes réseaux j'ai donc peut-être mal copié la macro, je vais réessayer je vous tiens au courant.

Je vais sinon essayer de produire quelque chose démontrant l'erreur que je rencontre.

XL 2016 Comparer deux colonnes et aligner - Bilan

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Accro

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Discussions similaires