XL 2016 consolidation plusieurs feuilles

gds77 · 22 Mars 2018

Bonjour à vous tous,
Je vais essayer d'être claire. Sur le fichier joint je dispose de 3 feuilles pour mes banques et pour lesquelles je souhaiterais sur la feuille synthèse consolider les colonnes G "montant" et les colonnes F "catégorie" en fonction des années 2017 et 2018. Mon point d'entrée serait la colonne E "émetteur".

Merci d'avance pour votre aide.

sousou · 22 Mars 2018

Bonjour
Je te propose une manière qui te permettra d'aller plus loin dans tes synthèses.
Dans la feuille consolidation , j'intègre toutes les données de toutes les banques plus une formule qui donne l'année.
Dans la feuille Tcd un tableau croisée que tu peux modifier, tu peux aussi ajouter d'autres tableaux dans cette feuille
Tu lances la macro consolidation.

gds77 · 22 Mars 2018

Bonjour Sousou,
Merci pour cette super proposition, mais mon employeur aura accès a ce document, et pour lui expliquer le fonctionnement impossible moi même trop novice sur ce sujet. C'est pourquoi, je pensais à des fonctions indirect en utilisant les années et les catégories, dans un premier temps. Mais je ne trouve pas de solutions.

job75 · 22 Mars 2018

Bonjour gds77, sousou,

Voyez le fichier joint et cette macro dans le code de la feuille SYNTHESE :

Code:

Private Sub Worksheet_Activate()
Dim a, annee1, annee2, d1 As Object, d2 As Object, i%, derlig&, j&, v1#, v2#, x$
a = Array("BP", "BCP", "CDN") 'feuilles à consolider
annee1 = [E3]: annee2 = [F3]
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
For i = 0 To UBound(a)
    With Sheets(a(i))
        derlig = .Range("E" & .Rows.Count).End(xlUp).Row
        For j = 6 To derlig
            If IsDate(.Cells(j, 2)) Then 'sécutité
                v1 = 0: v2 = 0
                If IsNumeric(.Cells(j, 7)) Then 'sécurité
                    If Year(.Cells(j, 2)) = annee1 Then
                        v1 = .Cells(j, 7)
                    ElseIf Year(.Cells(j, 2)) = annee2 Then
                        v2 = .Cells(j, 7)
                    End If
                End If
                x = .Cells(j, 5) & Chr(1) & .Cells(j, 6)
                d1(x) = d1(x) + v1: d2(x) = d2(x) + v2
            End If
        Next j
    End With
Next i
Application.ScreenUpdating = False
Range("C5:F" & Rows.Count).ClearContents
If d1.Count = 0 Then Exit Sub 'sécurité
[C5].Resize(d1.Count) = Application.Transpose(d1.keys) 'Transpose est limitée à 65536 lignes
[C5].Resize(d1.Count).TextToColumns [C5], xlDelimited, Other:=True, OtherChar:=Chr(1) 'commande Convertir
[E5].Resize(d1.Count) = Application.Transpose(d1.items)
[F5].Resize(d2.Count) = Application.Transpose(d2.items)
[C5].Resize(d1.Count, 4).Sort [C5], xlAscending, [D5], Header:=xlNo 'tri
Columns("C:F").AutoFit 'ajustement largeur
End Sub

Elle s'exécute quand on active la feuille.

PS : il y a des références circulaires dans votre fichier, tâchez de voir ça...

A+

gds77 · 22 Mars 2018

job75 à dit:

Bonjour gds77, sousou,

Voyez le fichier joint et cette macro dans le code de la feuille SYNTHESE :

Code:

Private Sub Worksheet_Activate()
Dim a, annee1, annee2, d1 As Object, d2 As Object, i%, derlig&, j&, v1#, v2#, x$
a = Array("BP", "BCP", "CDN") 'feuilles à consolider
annee1 = [E3]: annee2 = [F3]
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
For i = 0 To UBound(a)
    With Sheets(a(i))
        derlig = .Range("E" & .Rows.Count).End(xlUp).Row
        If derlig > 5 Then
            For j = 6 To derlig
                If IsDate(.Cells(j, 2)) Then
                    v1 = 0: v2 = 0
                    If IsNumeric(.Cells(j, 7)) Then
                        If Year(.Cells(j, 2)) = annee1 Then
                            v1 = .Cells(j, 7)
                        ElseIf Year(.Cells(j, 2)) = annee2 Then
                            v2 = .Cells(j, 7)
                        End If
                    End If
                    x = .Cells(j, 5) & Chr(1) & .Cells(j, 6)
                    d1(x) = d1(x) + v1: d2(x) = d2(x) + v2
                End If
            Next j
        End If
    End With
Next i
Application.ScreenUpdating = False
Range("C5:F" & Rows.Count).ClearContents
If d1.Count = 0 Then Exit Sub 'sécurité
[C5].Resize(d1.Count) = Application.Transpose(d1.keys) 'Transpose est limitée à 65536 lignes
[C5].Resize(d1.Count).TextToColumns [C5], xlDelimited, Other:=True, OtherChar:=Chr(1) 'commande Convertir
[E5].Resize(d1.Count) = Application.Transpose(d1.items)
[F5].Resize(d2.Count) = Application.Transpose(d2.items)
[C5].Resize(d1.Count, 4).Sort [C5], xlAscending, [D5], Header:=xlNo 'tri
Columns("C:F").AutoFit 'ajustement largeur
End Sub

Elle s'exécute quand on active la feuille.

PS : il y a des références circulaires dans votre fichier, tâchez de voir ça...

A+

gds77 · 22 Mars 2018

Oups fichier parti trop tôt ,

Merci job 75 pour cette macro, mais malheureusement je ne maitrise pas le fonctionnement et serais incapable de la recopier dans mon fichier de base , et je dois rendre ma synthèse pour ce soir. Alors j'ai chercher et pour simplifier j'ai essayé la fonction indirect uniquement sur les catégories mais je ne sais pas comment dissocier les années 2017 et 2018. Alors si vous pouvez m'indiquer la formule

Merci d'avance

job75 · 22 Mars 2018

Re,

J'ai supprimé un test inutile sur derlig dans ma macro précédente et j'ai mis le format "Comptabilité" en colonnes E et F.

gds77 à dit:
Merci job 75 pour cette macro, mais malheureusement je ne maitrise pas le fonctionnement et serais incapable de la recopier dans mon fichier de base

Si votre fichier de base a la même structure que celui du post #1 il n'est pas nécessaire de comprendre la macro .

Et copier la macro est hyper facile :

- clic droit sur l'onglet SYNTHESE et Visualiser le code

- coller le code

- enregistrer le fichier en .xlsm (acceptant les macros).

A+

gds77 · 22 Mars 2018

Surement, mais mon employeur me demande en plus de distinguer des colonnes débit et crédit sur une même catégorie quand le cas se présente....Alors pour modifier votre macro

Donc si une solution existe sans macro pour utiliser la fonction indirect + année + colonne débit et crédit....Je suis preneuse avec grand plaisir.

A+

job75 · 22 Mars 2018

Re,

gds77 à dit:
mon employeur me demande en plus de distinguer des colonnes débit et crédit sur une même catégorie

Il n'est pas difficile de modifier la macro, il suffit d'utiliser 4 Dictionary :

Code:

Private Sub Worksheet_Activate()
Dim a, annee1, annee2, d1 As Object, d2 As Object, d3 As Object, d4 As Object, i%, derlig&, j&, v1#, v2#, v3#, v4#, x$
a = Array("BP", "BCP", "CDN") 'feuilles à consolider
annee1 = [E3]: annee2 = [G3]
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")
Set d4 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
d2.CompareMode = vbTextCompare
d3.CompareMode = vbTextCompare
d4.CompareMode = vbTextCompare
For i = 0 To UBound(a)
    With Sheets(a(i))
        derlig = .Range("E" & .Rows.Count).End(xlUp).Row
        For j = 6 To derlig
            If IsDate(.Cells(j, 2)) Then 'sécutité
                v1 = 0: v2 = 0: v3 = 0: v4 = 0
                If IsNumeric(.Cells(j, 7)) Then 'sécurité
                    If Year(.Cells(j, 2)) = annee1 Then
                        If .Cells(j, 7) > 0 Then v1 = .Cells(j, 7) Else v2 = .Cells(j, 7)
                    ElseIf Year(.Cells(j, 2)) = annee2 Then
                        If .Cells(j, 7) > 0 Then v3 = .Cells(j, 7) Else v4 = .Cells(j, 7)
                    End If
                End If
                x = .Cells(j, 5) & Chr(1) & .Cells(j, 6)
                d1(x) = d1(x) + v1: d2(x) = d2(x) + v2
                d3(x) = d3(x) + v3: d4(x) = d4(x) + v4
            End If
        Next j
    End With
Next i
Application.ScreenUpdating = False
Range("C5:H" & Rows.Count).ClearContents
If d1.Count = 0 Then Exit Sub 'sécurité
[C5].Resize(d1.Count) = Application.Transpose(d1.keys) 'Transpose est limitée à 65536 lignes
[C5].Resize(d1.Count).TextToColumns [C5], xlDelimited, Other:=True, OtherChar:=Chr(1) 'commande Convertir
[E5].Resize(d1.Count) = Application.Transpose(d1.items)
[F5].Resize(d2.Count) = Application.Transpose(d2.items)
[G5].Resize(d3.Count) = Application.Transpose(d3.items)
[H5].Resize(d4.Count) = Application.Transpose(d4.items)
[C5].Resize(d1.Count, 6).Sort [C5], xlAscending, [D5], Header:=xlNo 'tri
Columns("C:H").AutoFit 'ajustement largeur
End Sub

Fichier (2).

A+

gds77 · 22 Mars 2018

Etant pas douée en macro, j'ai bien réussi à visualiser le code mais comment l'importer dans mon fichier de base ?

Merci

gds77 · 22 Mars 2018

j'ai enfin réussi à coller la macro. Mais le Hic c'est qu'il me manque mes sous totaux par catégorie. Pouvez vous m'indiquez la marche à suivre ?

Merci d'avance

gds77 · 22 Mars 2018

Sur mon fichier d'origine, les cellules en colonne "E" ne sont pas toutes sous le même format (trop compliqué pour l'analyse). Pour simplifier, Est il possible donc de supprimer cette colonne et de n'afficher que les catégories.

Encore Merci

sousou · 22 Mars 2018

Re
J'insiste sur mes tcd, regarde cette solution où il n'y a rien à expliquer

gds77 · 22 Mars 2018

Merci Sousou, en effet ton TCD est une bonne solution à mon problème, mais je ne retrouve pas le bon résultat entre Débit - Crédit et Résultat sur le tri fait par catégorie.
exemple : BFA 2017 en débit 283 €- en Crédit 0€ - et résultat 40431 €.
de plus je dois afficher les année 2017 et 2018 en colonne et pas en ligne.

sousou · 22 Mars 2018

Re
Exact
Essaie avec celui-ci
Savez-vous toi et ton boss utiliser les tableaux croisés?, Tout dans outils tableau croisé après l'avoir sélectionner

XL 2016 consolidation plusieurs feuilles

gds77

XLDnaute Occasionnel

Pièces jointes

sousou

XLDnaute Barbatruc

Pièces jointes

gds77

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

gds77

XLDnaute Occasionnel

Pièces jointes

gds77

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

gds77

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

gds77

XLDnaute Occasionnel

gds77

XLDnaute Occasionnel

gds77

XLDnaute Occasionnel

sousou

XLDnaute Barbatruc

Pièces jointes

gds77

XLDnaute Occasionnel

sousou

XLDnaute Barbatruc

Pièces jointes

Discussions similaires