Résolu XL 2016 Comparer deux colonnes et aligner - Bilan

pilotdankevin

XLDnaute Nouveau
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/
 
Ce fil a été résolu! Aller à la solution…

Fichiers joints

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour pilotdankevin, et bienvenu sur XLD,
En PJ un essai avec une macro :
Code:
Sub Aligne()
Dim DerLig As Integer, L As Integer, IndexW As Integer
Sheets("JE VEUX ÇA").Range("A2:C65000").ClearContents
DerLig = Sheets("BILAN 1").Range("A65500").End(xlUp).Row
' partout on utilise RTrim qui supprime les espaces à droite. ( Voir fichier "Resultat" et Resultat " )
' Copie de Bian1 dans "Je veux ça"
For L = 2 To DerLig
    Sheets("JE VEUX ÇA").Cells(L, 1) = RTrim(Sheets("BILAN 1").Cells(L, 1))
    Sheets("JE VEUX ÇA").Cells(L, 2) = RTrim(Sheets("BILAN 1").Cells(L, 2))
Next L
DerLig = Sheets("BILAN 2").Range("A65500").End(xlUp).Row
For L = 2 To DerLig
    If Not IsError(Application.Match(RTrim(Sheets("BILAN 2").Cells(L, 1)), Sheets("JE VEUX ÇA").Range("A:A"), 0)) Then
        ' L'item existe donc on remplit la colonne C
        IndexW = Application.Match(RTrim(Sheets("BILAN 2").Cells(L, 1)), Sheets("JE VEUX ÇA").Range("A:A"), 0)
        Sheets("JE VEUX ÇA").Cells(IndexW, 3) = Sheets("BILAN 2").Cells(L, 2)
    Else
        ' L'item n'existe pas dans la colonne C, on le créé
        IndexW = 1 + Sheets("JE VEUX ÇA").Range("A65500").End(xlUp).Row
        Sheets("JE VEUX ÇA").Cells(IndexW, 1) = RTrim(Sheets("BILAN 2").Cells(L, 1))
        Sheets("JE VEUX ÇA").Cells(IndexW, 3) = RTrim(Sheets("BILAN 2").Cells(L, 2))
    End If
Next L
End Sub
Par défaut je mets tout le bilan 1 et après les lignes absentes de Bilan 2.
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour pilotdankevin, bienvenue sur XLD,

Voyez le fichier joint et cette macro dans le code de la dernière feuille :
VB:
Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, x$, n&
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
ReDim resu(1 To Rows.Count, 1 To 3)
tablo = Feuil1.[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = Trim(tablo(i, 1))
    If Not d.exists(x) Then
        n = n + 1
        d(x) = n 'mémorise la ligne
        resu(n, 1) = x
        resu(n, 2) = tablo(i, 2)
    End If
Next i
tablo = Feuil2.[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = Trim(tablo(i, 1))
    If d.exists(x) Then
        resu(d(x), 3) = tablo(i, 2)
    Else
        n = n + 1
        d(x) = ""
        resu(n, 1) = x
        resu(n, 3) = tablo(i, 2)
    End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution, à adapter
    If n Then .Resize(n, 3) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
End Sub
Elle se déclenche automatiquement quand on active la feuille.

L'exécution est très rapide car on utilise des tableaux VBA et le Dictionary.

Nota : il y a des espaces superflus dans vos textes mais avec Trim pas de problème !

Edit ; salut sylvanu, pas rafraîchi.

A+
 

Fichiers joints

Dernière édition:

pilotdankevin

XLDnaute Nouveau
Bonjour,

Désolé pour ce retour tardif, j'ai mis un certain temps avant de me repencher dessus :)

Alors pour toi sylvanu, je comprends ce que tu as fait, mais sur mon vrai Excel ça ne fonctionne pas… ça me parait cohérent mais ça me sort pas les données correspondantes et seulement les intitulés de texte (Provisions etc..). De plus, vu le nombre de lignes important, je ne peux pas faire un traitement du bilan 1 puis des lignes manquantes du bilan 2. Il faut que tout soit aligné et des "espaces" blancs placés lorsqu'un des deux côté il n'y a pas de valeur.

job75 je ne comprends pas ta macro et comment l'adapter pour mon doc réel. A quoi correspond tablo ? Je n'arrive pas a sortir ce que je veux …

Voici un nouveau fichier qui ressemble plus à mon vrai Excel. C'est peut-être les totaux intermédiaires qui créent les problèmes, ou bien les ** ou les codes avant les intitulés ?

A savoir que dans mon vrai Excel comme ici il n'y a aucune formule de somme etc.. (pour les valeurs brutes notamment), mais juste le chiffre correspondant à sa ligne.

Merci beaucoup ! :)
 

Fichiers joints

excfl

XLDnaute Barbatruc
Bonjour pilotdankevin, sylvanu, job75

"comparer deux bilans comptable sur Excel"

Les bilans présentés n'ont rien de normalisés ?
 

job75

XLDnaute Barbatruc
Bonjour pilotdankevin, le forum,

Voyez le fichier joint et cette macro qui fait pratiquement ce que vous avez demandé :
VB:
Private Sub Worksheet_Activate()
Dim d1 As Object, d2 As Object, resu(), tablo, i&, n&, x$, y$, c As Range
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 3)
tablo = Feuil2.[B2].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    n = n + 1
    x = Trim(tablo(i, 1))
    resu(n, 1) = x
    resu(n, 3) = tablo(i, 2)
    d1(x) = d1(x) + 1 'compte
    d2(x & Chr(1) & d1(x)) = n 'repère la ligne
Next
tablo = Feuil1.[B2].CurrentRegion.Resize(, 2) 'matrice, plus rapide
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
        resu(d2(y), 2) = tablo(i, 2)
    Else
        n = n + 1
        resu(n, 1) = x
        resu(n, 2) = tablo(i, 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, 3) = resu
        .Resize(n, 3).Font.Bold = False 'non gras
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).Delete xlUp 'RAZ en dessous
    '---traitement de la ligne Bilan---
    Set c = .EntireColumn.Find("Bilan", .Cells(0), xlValues, xlWhole)
    If Not c Is Nothing Then
        c.Resize(, 3).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
On utilise maintenant 2 Dictionary, c'est toujours très rapide.

Pour tester j'ai recopié chaque bilan sur 88 000 lignes, chez moi l'exécution prend 2,5 secondes.

Bonne journée.
 

Fichiers joints

pilotdankevin

XLDnaute Nouveau
Bonjour,

Excelf, c'est à dire ? Les bilan sont normalisés, il y a un certain nombre d'entrées et les "**Valeur brutes" sont des sous totaux, il y a donc énormément d'entrées comme celle-ci. Et là est le point de blocage sur cette macro justement ...

Job 75, quand j'applique a mon fichier, les entrées qui sont dans le bilan M et pas dans le bilan N-1 se retrouvent à la toute fin de mon tableau comparatif.

-> Quand il y a une ligne dans N-1 et pas dans M, cela fonctionne très bien. On retrouve cette ligne au bon endroit, avec aucune valeur renseignée dans M. Mais par contre, ce qui est dans M et pas dans N-1 se retrouve tout en bas de mon tableau. J'ai l'impression que la macro traite tout N-1 en puis pour ce qui est en plus dans M, tout se rajoute à la fin.

Pour être honnête, je ne maîtrise pas les matrices et Dictionnary, je ne parviens pas à comprendre d'où provient le problème. Je pense qu'il faudrait traiter ligne par ligne pour chacun des bilan ? J'espère être clair sur ce qui bloque encore,

Merci :)
 

job75

XLDnaute Barbatruc
Job 75, quand j'applique a mon fichier, les entrées qui sont dans le bilan M et pas dans le bilan N-1 se retrouvent à la toute fin de mon tableau comparatif.
C'est tout à fait normal puisqu'on analyse les bilans l'un à la suite de l'autre.

Je ne vois pas pourquoi ce serait gênant.

Toute autre solution prendrait beaucoup plus de temps.

Au fait combien de lignes au maximum peuvent avoir vos bilans ?
 

job75

XLDnaute Barbatruc
Avec le fichier (1) on analyse d'abord le bilan N-1 puis le bilan M.

Avec ce fichier (1 bis) on analyse d'abord le bilan M puis le bilan N-1.

Alors bien sûr ce qui est dans N-1 et pas dans M se retrouve à la fin du tableau comparatif.
 

Fichiers joints

pilotdankevin

XLDnaute Nouveau
Cela est gênant car justement, dans un bilan comptable, chaque ligne doit être à sa place, et avant le bon sous total. On ne peut pas mettre les lignes en trop de M à la fin car ce n'est pas là qu'elles vont en comptabilité. Mes bilans font environ 1000 lignes.

C'est ça qui rend la chose compliquée malheureusement … J'ai cherché et trouvé pas mal de solutions, mais à chaque fois les lignes en trop se retrouvent à la fin, sauf que ce n'est pas valable et utilisable en comptabilité .. Je ne trouve pas de solution adaptable à mon cas.

Je vois pas du tout comment m'y prendre pour un traitement ligne par ligne et pour que on ne se retrouve pas avec ce qui est en trop à la fin ?

Si job75 ou d'autres vous avez des pistes je suis preneur ...

Merci encore :D
 

job75

XLDnaute Barbatruc
Vous trouverez une solution dans ce fichier (2).

Elle consiste à insérer les lignes de bilan non traitées dans le tableau restitué :
VB:
Private Sub Worksheet_Activate()
Dim d1 As Object, d2 As Object, resu(), tablo, i&, n&, x$, y$, lig&, c As Range
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 3)
tablo = Feuil1.[B2].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    n = n + 1
    x = Trim(tablo(i, 1))
    resu(n, 1) = x
    resu(n, 2) = tablo(i, 2)
    d1(x) = d1(x) + 1 'compte
    d2(x & Chr(1) & d1(x)) = n 'repère la ligne
Next
tablo = Feuil2.[B2].CurrentRegion.Resize(, 3) '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
        resu(d2(y), 3) = tablo(i, 2)
        tablo(i, 3) = d2(y) 'repère le numéro de ligne
    Else
        tablo(i, 3) = ""
    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, 3) = resu
    .Resize(Rows.Count - .Row + 1, 3).Font.Bold = False 'non gras
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
    '---insertion des lignes du 2ème bilan non traitées---
    For i = 2 To UBound(tablo)
        If tablo(i, 3) = "" Then
            lig = Val(tablo(i - 1, 3)) + 1
            If lig > 1 Then .Cells(lig, 1).Resize(, 3).Insert xlDown
            .Cells(lig, 1) = tablo(i, 1)
            .Cells(lig, 3) = tablo(i, 2)
            tablo(i, 3) = 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(, 3).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
Evidemment l'insertion de lignes prend du temps mais avec des bilans de seulement 1000 lignes il n'y aura aucun problème, cela prendra au plus quelques dixièmes de secondes.

Edit : code amélioré en tenant compte des cas où les bilans sont vides.
 
Ce message a été identifié comme étant une solution!

Fichiers joints

Dernière édition:

pilotdankevin

XLDnaute Nouveau
C'est génial ! Ca marche super merci :D

Simplement, si je veux changer la colonne de donnée restituée (la on restitue SOMME STE, imaginons qu'il y a une autre colonne à sa droite). Je dois changer le Offset(n). Insert ? Ou une autre ligne ?

Encore merci à vous, je ne pense pas que j'aurais réussi seul :)
 

job75

XLDnaute Barbatruc
Il y avait une petite erreur dans la macro précédente pour la copie après l'insertion, j'ai corrigé.
Simplement, si je veux changer la colonne de donnée restituée (la on restitue SOMME STE, imaginons qu'il y a une autre colonne à sa droite). Je dois changer le Offset(n). Insert ? Ou une autre ligne ?
Il faut revoir toute la macro, le tableau des résultats a maintenant 5 colonnes, fichier (3) :
Code:
Private Sub Worksheet_Activate()
Dim d1 As Object, d2 As Object, resu(), tablo, i&, n&, x$, y$, lig&, c As Range
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 5)
tablo = Feuil1.[B2].CurrentRegion.Resize(, 3) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    n = n + 1
    x = Trim(tablo(i, 1))
    resu(n, 1) = x
    resu(n, 2) = tablo(i, 2)
    resu(n, 3) = tablo(i, 3)
    d1(x) = d1(x) + 1 'compte
    d2(x & Chr(1) & d1(x)) = n 'repère la ligne
Next
tablo = Feuil2.[B2].CurrentRegion.Resize(, 4) '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
        resu(d2(y), 4) = tablo(i, 2)
        resu(d2(y), 5) = tablo(i, 3)
        tablo(i, 4) = d2(y) 'repère le numéro de ligne
    Else
        tablo(i, 4) = ""
    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, 5) = resu
    .Resize(Rows.Count - .Row + 1, 5).Font.Bold = False 'non gras
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 5).ClearContents 'RAZ en dessous
    '---insertion des lignes du 2ème bilan non traitées---
    For i = 2 To UBound(tablo)
        If tablo(i, 4) = "" Then
            lig = Val(tablo(i - 1, 4)) + 1
            If lig > 1 Then .Cells(lig, 1).Resize(, 5).Insert xlDown
            .Cells(lig, 1) = tablo(i, 1)
            .Cells(lig, 4) = tablo(i, 2)
            .Cells(lig, 5) = tablo(i, 3)
            tablo(i, 4) = 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
A+
 

Fichiers joints

pilotdankevin

XLDnaute Nouveau
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

XLDnaute Barbatruc
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
 
Ce message a été identifié comme étant une solution!

Fichiers joints

pilotdankevin

XLDnaute Nouveau
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 :D
 

pilotdankevin

XLDnaute Nouveau
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 :D
 

klin89

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

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas