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/
 

Pièces jointes

  • ALIGNCOMPAR_BILAN.xlsx
    10.2 KB · Affichages: 42
Solution
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+

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.
 

Pièces jointes

  • ALIGNCOMPAR_BILAN (1).xlsm
    18.3 KB · Affichages: 12

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+
 

Pièces jointes

  • ALIGNCOMPAR_BILAN(1).xlsm
    19.6 KB · Affichages: 9
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 ! :)
 

Pièces jointes

  • COMPARBILAN2.xlsx
    10.8 KB · Affichages: 11

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.
 

Pièces jointes

  • COMPARBILAN2(1).xlsm
    24 KB · Affichages: 9

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.
 

Pièces jointes

  • COMPARBILAN2(1 bis).xlsm
    22.9 KB · Affichages: 8

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.
 

Pièces jointes

  • COMPARBILAN2(2).xlsm
    24.4 KB · Affichages: 5
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+
 

Pièces jointes

  • COMPARBILAN2(3).xlsm
    26.1 KB · Affichages: 6

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T