XL 2016 Comparer deux colonnes et aligner - Bilan

[pilotdankevin]

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/

 

[sylvanu]

Bonjour pilotdankevin, et bienvenu sur XLD,
En PJ un essai avec une macro :

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.

 

[job75]

Bonjour pilotdankevin, bienvenue sur XLD,

Voyez le fichier joint et cette macro dans le code de la dernière feuille :

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+

 

[pilotdankevin]

Bonjour,

Merci pour vos retours rapides ! Je vais adapter à mon fichier, je vous dit très prochainement si cela fonctionne

 

[pilotdankevin]

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 !

 

[excfl]

Bonjour pilotdankevin, sylvanu, job75

"comparer deux bilans comptable sur Excel"

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

 

[job75]

Bonjour,

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

Je plussoie, il ne paraît pas normal que sans chaque bilan il y ait 3 fois **Valeurs brutes.

Ma macro suppose qu'il n'y a pas de doublon.

A+

 

[job75]

Bonjour pilotdankevin, le forum,

Voyez le fichier joint et cette macro qui fait pratiquement ce que vous avez demandé :

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.

 

[pilotdankevin]

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]

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]

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.

 

[pilotdankevin]

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

 

[job75]

Vous trouverez une solution dans ce fichier (2).

Elle consiste à insérer les lignes de bilan non traitées dans le tableau restitué :

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.

 

[pilotdankevin]

C'est génial ! Ca marche super merci

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]

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) :

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+