Tableau avec un décalage d'une colonne à l'autre et doublons
Bonjour à tous,
Je suis désolé je me fais mal comprendre, très peu d'expérience avec VBA et très embêté avec un tableau qui utilise collection. J'ai instruit une array
Catégorie1 = Array("Production vendue", "Prestations de service", "Ventes de marchandises", "CA activités annexes"). Pour la remplir j'ai réalisé une boucle qui parcourt toutes les feuilles "BG" & MaxAnnee avec MaxAnnee qui est déterminé sur une plage de mon P&L. Il semble que je suis parvenu à gérer mes doublons mais lorsque j'exécute la partie suivante de mon code, j'ai soit mes catégories en double "Production vendue" deux fois avec un décalage d'une ligne vers le bas pour les montants
For i = 14 To colonne
MaxAnnee = Cells(6, i).Value
For Each Catégorie In Catégories
If Not CatégoriesAjoutées.Exists(Catégorie) Then
CatégoriesAjoutées(Catégorie) = True
RowTarget = LastRowPL + 1
wsPL.Cells(RowTarget, "D").Value = Catégorie wsPL.Cells(RowTarget, "D").Font.Bold = True
wsPL.Cells(RowTarget, i).FormulaR1C1 = "=SUMIF(" & "bg_mapping_" & MaxAnnee & ", RC4, " & "bg_solde_credit_" & MaxAnnee & ")"
SommeCatégories = SommeCatégories + wsPL.Cells(RowTarget, i).Value
LastRowPL = RowTarget
End If
For Each Ligne In Catégories(Catégorie)
LastRowPL = LastRowPL + 1
wsPL.Cells(LastRowPL, "E").Font.Bold = False
wsPL.Cells(LastRowPL, "E").Value = Ligne
wsPL.Cells(LastRowPL, i).FormulaR1C1 = "=SUMIF(" & "bg_compte_num_" & MaxAnnee & ", RIGHT(RC5,6), " & "bg_solde_credit_" & MaxAnnee & ")"
LastRowPL = RowTarget + 1
Next Ligne
Next Catégorie
Next i
<br>
bonjour Giovax,
c'est un "collection" ou un "dictionary" ?
Vous avez le fichier (anonymisé) avec cette macro ?
Bonjour,
Et merci de prendre le temps de me répondre
Voici la partie plus complète du code. J'ai décidé de procéder en 2 étapes finalement pour d'abord n'avoir aucun doublon, ce qui n'était pas une mince affaire. Je tenterait une nouvelle boucle pour mes formules. Fichier trop lourd pour vous le transmettre malheureusement. Je ne parviens à gérer les doublons qu'en bricolant et en ajoutant du code supplémentaire
Sub MaMacro()
' Déclarer les variables
' Déclarez toutes les variables nécessaires
Dim MaxAnnee, MaxAnnee2 As Integer
Dim wsBG, wsPL As Worksheet
Dim LastRow As Long, RowTarget As Long, LastRowBG As Long, LastRowPL As Long
Dim sourceRange As Range
Dim NumCompte As Variant, CatégorieFeuille As Variant, LigneDonnée As Variant
Dim Catégorie As Variant
Dim SommeCatégories As Double, PEx As Double, CEx As Double, REx As Double, Rn As Double
Dim Catégories, CatégoriesUniques, Totaux As Object
Dim Catégorie1(), Catégorie2(), Catégorie3(), Catégorie4(), Catégorie5() As Variant
' Définissez les catégories
Catégorie1 = Array("Production vendue", "Prestations de service", "Ventes de marchandises", "CA activités annexes")
Catégorie2 = Array("Subventions", "Production stockée", "Production immobilisée", "Reprises sur amortissements et provisions", "Transfert de charges")
Catégorie3 = Array("Achats de matières premières", "Variation de stocks de matières premières", "Achats de marchandises", "Variation de stocks de marchandises", "Achats stockés - Autres appros.", "Var. stock achats stockés - autres appros.", "Autres achats et ch. externes", "Salaires et traitements", "Charges sociales", "Impôts et taxes", "D&A")
Catégorie4 = Array("Autres produits / charges")
Catégorie5 = Array("Résultat financier", "Résultat exceptionnel", "IS", "Participation des salariés")
' Définissez la feuille "P&L"
Set wsPL = ThisWorkbook.Sheets("P&L")
' Trouvez la dernière colonne dans "P&L"
LastColumnPL = wsPL.Cells(6, wsPL.Columns.Count).End(xlToLeft).Column
MaxAnnee2 = wsPL.Cells(6, LastColumnPL).Value
LastRow = wsPL.Cells(wsPL.Rows.Count, "D").End(xlUp).Row
colonne = ColonneAnnee2(Rows("6:6"), MaxAnnee2)
LastRowPL = 7
Set Catégories = CreateObject("Scripting.Dictionary")
' Parcourez chaque catégorie
For Each Catégorie In Catégorie1
Dim ValeursUniques As Object
Set ValeursUniques = CreateObject("Scripting.Dictionary")
' Parcourez les années et les feuilles "BG"
For i = 14 To colonne
MaxAnnee = wsPL.Cells(6, i).Value
Set wsBG = ThisWorkbook.Sheets("BG " & MaxAnnee)
LastRowBG = wsBG.Cells(wsBG.Rows.Count, "A").End(xlUp).Row
For RowBG = 2 To LastRowBG
NumCompte = wsBG.Cells(RowBG, "D").Value ' Colonne "compte_num"
CatégorieFeuille = wsBG.Cells(RowBG, "A").Value ' Colonne "mapping_bp"
If Left(NumCompte, 1) = "7" And CatégorieFeuille = Catégorie Then
If Not ValeursUniques.Exists(NumCompte) Then
ValeursUniques(NumCompte) = wsBG.Cells(RowBG, "E").Value & " " & NumCompte
End If
End If
Next RowBG
Set CatégoriesUniques = CreateObject("Scripting.Dictionary")
If Not CatégoriesUniques.Exists(Catégorie) Then
CatégoriesUniques(Catégorie) = True
End If
If Not Catégories.Exists(Catégorie) Then
Set Catégories(Catégorie) = New Collection
End If
For Each NumCompte In ValeursUniques.Keys
Catégories(Catégorie).Add ValeursUniques(NumCompte)
Next NumCompte
Next i
Next Catégorie
For Each Catégorie In Catégories.Keys
Dim LignesUniques As Object
Set LignesUniques = CreateObject("Scripting.Dictionary")
LastRowPL = LastRowPL + 1
wsPL.Cells(LastRowPL, "D").Value = Catégorie
wsPL.Cells(LastRowPL, "D").Font.Bold = True
For Each Ligne In Catégories(Catégorie)
If Not LignesUniques.Exists(Ligne) Then
LignesUniques(Ligne) = True
LastRowPL = LastRowPL + 1
wsPL.Cells(LastRowPL, "E").Font.Bold = False
wsPL.Cells(LastRowPL, "E").Value = Ligne
End If
Next Ligne
Next Catégoriere,
supprimé !!!
C'est quoi exactement le but de cette macro ?
re, un petit pari ... un dictionaire de dictionaires
Sub Cow_18()
' Déclarer les variables
' Déclarez toutes les variables nécessaires
Dim MaxAnnee, MaxAnnee2 As Integer
Dim wsBG, wsPL As Worksheet
Dim LastRow As Long, RowTarget As Long, LastRowBG As Long, LastRowPL As Long
Dim sourceRange As Range
Dim NumCompte As Variant, CatégorieFeuille As Variant, LigneDonnée As Variant
Dim Catégorie As Variant
Dim SommeCatégories As Double, PEx As Double, CEx As Double, REx As Double, Rn As Double
Dim Catégories, CatégoriesUniques, Totaux As Object
Dim Catégorie1(), Catégorie2(), Catégorie3(), Catégorie4(), Catégorie5() As Variant
Dim aKeys
' Définissez les catégories
Catégorie1 = Array("Production vendue", "Prestations de service", "Ventes de marchandises", "CA activités annexes")
Catégorie2 = Array("Subventions", "Production stockée", "Production immobilisée", "Reprises sur amortissements et provisions", "Transfert de charges")
Catégorie3 = Array("Achats de matières premières", "Variation de stocks de matières premières", "Achats de marchandises", "Variation de stocks de marchandises", "Achats stockés - Autres appros.", "Var. stock achats stockés - autres appros.", "Autres achats et ch. externes", "Salaires et traitements", "Charges sociales", "Impôts et taxes", "D&A")
Catégorie4 = Array("Autres produits / charges")
Catégorie5 = Array("Résultat financier", "Résultat exceptionnel", "IS", "Participation des salariés")
' Définissez la feuille "P&L"
Set wsPL = ThisWorkbook.Sheets("P&L")
wsPL.Range("D:E").ClearContents
' Trouvez la dernière colonne dans "P&L"
LastColumnPL = wsPL.Cells(6, wsPL.Columns.Count).End(xlToLeft).Column
MaxAnnee2 = wsPL.Cells(6, LastColumnPL).Value
LastRow = wsPL.Cells(wsPL.Rows.Count, "D").End(xlUp).Row
'colonne = ColonneAnnee2(Rows("6:6"), MaxAnnee2)
LastRowPL = 7
Set Catégories = CreateObject("Scripting.Dictionary") 'dictionaire de dictionaires
Catégories.comparemode = vbTextCompare
For Each Cat In Catégorie1 'ajouter tous les catégories dans leur séquence originale
Set Catégories(Cat) = CreateObject("scripting.dictionary")
Next
For iAnnee = 2022 To 2024
'MaxAnnee = wsPL.Cells(6, i).Value
Set wsBG = ThisWorkbook.Sheets("BG " & iAnnee)
LastRowBG = wsBG.Cells(wsBG.Rows.Count, "A").End(xlUp).Row
For RowBG = 2 To LastRowBG
NumCompte = wsBG.Cells(RowBG, "B").Value ' Colonne "compte_num"
CatégorieFeuille = wsBG.Cells(RowBG, "A").Value ' Colonne "mapping_bp"
r = Application.Match(CatégorieFeuille, Catégorie1, 0) 'c'est un Catégorie1 ?
If IsNumeric(r) And Left(NumCompte, 1) = "7" Then
Set it = Catégories(CatégorieFeuille)
it(NumCompte) = vbEmpty
aKeys = it.keys
End If
Next
Next
For Each Catégorie In Catégories.keys
LastRowPL = LastRowPL + 1
With Catégories(Catégorie) 'un catégorie
If .Count > 0 Then 'contient des données
aKeys = .keys 'ces données
Set c = wsPL.Cells(Rows.Count, "D").End(xlUp).Offset(1)
If c.Row < 7 Then Set c = c.Offset(7 - c.Row)
With c.Resize(UBound(aKeys) + 1)
.Value = Catégorie
.Offset(, 1).Value = Application.Transpose(aKeys)
End With
End If
End With
Next Catégorie
End Sub
Merci beaucoup je vais essayer en rentrant et vous tiendrai informés
Pour le but de la macro, je dois automatiser un P&L (compte de résultats) d’une entreprise. Je réalise d’abord des balance générale annuelle et je suis parvenu ensuite à automatiser le P&L annuel. Le but ensuite est de fusionner les P&L en utilisant des dictionnaires et ensuite pouvoir étudier les variations annuelles.
Je lutte vraiment, notamment pour appliquer mes formules avec la gestions des boucles, par exemple pour la partie
For Each Catégorie In Catégories.Keys
Dim LignesUniques As Object
Set LignesUniques = CreateObject("Scripting.Dictionary")
LastRowPL = LastRowPL + 1
wsPL.Cells(LastRowPL, "D").Value = Catégorie
wsPL.Cells(LastRowPL, "D").Font.Bold = True
For Each Ligne In Catégories(Catégorie)
If Not LignesUniques.Exists(Ligne) Then
LignesUniques(Ligne) = True
LastRowPL = LastRowPL + 1
wsPL.Cells(LastRowPL, "E").Font.Bold = False
wsPL.Cells(LastRowPL, "E").Value = Ligne
End If
Next Ligne
Next Catégorieje dois normalement insérer une autre boucle for i =14 to colonne avec colonne qui est la dernière année du P&L et ensuite appliquer des formules. Mais je n’y parvient pas directement dans cette boucle et vais être contraint d’en faire une nouvelle qui va alourdir mon code
re,
pouvez-vous montrer 2 feuilles anonymisées "BG ..." avec une dizaine de lignes et la feuille "P&L" aussi avec une dizaine de lignes et puis le résultat que vous voulez.
Les cellules et les entêtes qui n'ont pas d'importance pour cette macro, vous les remplacer avec par exemple "---".
Normallement, je pense qu'on peut tout faire dans un boucle, mais il faut savoir d'avance combien de données qu'on doit récupérer.
Voici le fichier avec les feuilles BG et le P&L tels qu'il devrait apparaitre pour la Catégorie1. L'objet est d'appliquer les fonctions que j'ai remis en dans la feuille P&L pour les colonnes 2021 puis 2022.
Pour information j'ai testé le code que vous m'avez gentiment proposé. Il semble qu'il remplit bien les dictionnaires mais les résultats ne s'affichent pas dans le P&L
Voici le code que j'ai rajouté et qui semble fonctionner
LastRow = wsPL.Cells(wsPL.Rows.Count, "E").End(xlUp).Row
LastRowPL = 7
For i = 14 To colonne
For RowPL = LastRowPL To LastRow + 1
MaxAnnee = wsPL.Cells(6, i).value
If Cells(RowPL, "D").value <> "" Then
wsPL.Cells(RowPL, "D").Offset(0, (10 + i - 14)).FormulaR1C1 = "=SUMIF(" & "bg_mapping_" & MaxAnnee & ", RC4, " & "bg_solde_credit_" & MaxAnnee & ")"
SommeCatégories = SommeCatégories + wsPL.Cells(RowPL, (10 + i - 14)).value
ElseIf Cells(RowPL, "E").value <> "" Then
wsPL.Cells(RowPL, "E").Offset(0, (9 + i - 14)).FormulaR1C1 = "=SUMIF(" & "bg_compte_num_" & MaxAnnee & ", RIGHT(RC5,6), " & "bg_solde_credit_" & MaxAnnee & ")"
End If
Next RowPL
Next ibonsoir, je n'affichais rien parce que je n'avais pas assez d'info, mais maintenant, je suppose que vous voulez créer une sorte de tableau croisé dynamique (TCD), voir feuille "TCD", pour le moment seulement pour vous donner l'idée. Le triage peut encore améliorer. On a tous ces segments à droite qui vous aident à filtrer le résultat.
EDIT: je vois que vous avez fait des progrès, j'attends pour voir ce que vous en pensez.
Je me suis résolu à utiliser une nouvelle boucle qui fonctionne. Voici ce que cela donne pour la Catégorie 1. C'est très moche mais ça fonctionne. Votre approche est TCD est magique!
Sub MaMacro()
' Déclarer les variables
' Déclarez toutes les variables nécessaires
Dim MaxAnnee As Integer
Dim wsSource As Worksheet, wsTarget As Worksheet, wsBG As Worksheet, wsPL As Worksheet
Dim LastRow As Long, RowTarget As Long, LastRowBG As Long, LastRowPL As Long
Dim sourceRange As Range
Dim NumCompte As Variant, CatégorieFeuille As Variant, LigneDonnée As Variant
Dim Catégorie As Variant
Dim SommeCatégories As Double, PExi As Double, CExi As Double, RExi As Double, Rni As Double
Dim Catégories, CatégoriesUniques, LignesUniques, ValeursUniques As Object
Dim Catégorie1(), Catégorie2(), Catégorie3(), Catégorie4(), Catégorie5() As Variant
Dim Totaux(), PEx(), CEx(), REx(), Rn() As Double
Sheets("P&L").Select
Rows("8:8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Selection.Font.Bold = False
' Définissez les catégories
Catégorie1 = Array("Production vendue", "Prestations de service", "Ventes de marchandises", "CA activités annexes")
Catégorie2 = Array("Subventions", "Production stockée", "Production immobilisée", "Reprises sur amortissements et provisions", "Transfert de charges")
Catégorie3 = Array("Achats de matières premières", "Variation de stocks de matières premières", "Achats de marchandises", "Variation de stocks de marchandises", "Achats stockés - Autres appros.", "Var. stock achats stockés - autres appros.", "Autres achats et ch. externes", "Salaires et traitements", "Charges sociales", "Impôts et taxes", "D&A")
Catégorie4 = Array("Autres produits / charges")
Catégorie5 = Array("Résultat financier", "Résultat exceptionnel", "IS", "Participation des salariés")
' Définissez la feuille "P&L"
Set wsPL = ThisWorkbook.Sheets("P&L")
' Trouvez la dernière colonne dans "P&L"
LastColumnPL = wsPL.Cells(6, wsPL.Columns.Count).End(xlToLeft).Column
MaxAnnee2 = wsPL.Cells(6, LastColumnPL).value
LastRow = wsPL.Cells(wsPL.Rows.Count, "D").End(xlUp).Row
colonne = ColonneAnnee2(Rows("6:6"), MaxAnnee2)
LastRowPL = 7
SommeCatégories = 0
PExi = 0
CExi = 0
RExi = 0
Rni = 0
' Initialisation de l'objet Catégories
Set Catégories = CreateObject("Scripting.Dictionary")
' Parcourez chaque catégorie
For Each Catégorie In Catégorie1
' Créez un dictionnaire pour stocker les valeurs uniques
Set ValeursUniques = CreateObject("Scripting.Dictionary")
' Parcourez les années et les feuilles "BG"
For i = 14 To colonne
MaxAnnee = wsPL.Cells(6, i).value
Set wsBG = ThisWorkbook.Sheets("BG " & MaxAnnee)
LastRowBG = wsBG.Cells(wsBG.Rows.Count, "A").End(xlUp).Row
' Parcourez la colonne "compte_num" sur la feuille "BG MaxAnnee" pour les comptes commençant par "7"
For RowBG = 2 To LastRowBG ' Commencez à partir de la deuxième ligne pour éviter les en-têtes
NumCompte = wsBG.Cells(RowBG, "D").value ' Colonne "compte_num"
CatégorieFeuille = wsBG.Cells(RowBG, "A").value ' Colonne "mapping_bp"
' Vérifiez si le numéro de compte commence par "7" et si la catégorie correspond à celle actuellement traitée
If Left(NumCompte, 1) = "7" And CatégorieFeuille = Catégorie Then
' Vérifiez si la valeur existe déjà dans le dictionnaire des valeurs uniques
If Not ValeursUniques.Exists(NumCompte) Then
' Si la valeur n'existe pas, ajoutez-la au dictionnaire des valeurs uniques
ValeursUniques(NumCompte) = wsBG.Cells(RowBG, "E").value & " " & NumCompte
End If
End If
Next RowBG
Set CatégoriesUniques = CreateObject("Scripting.Dictionary")
' Vérifiez si la catégorie existe dans le dictionnaire des catégories uniques
If Not CatégoriesUniques.Exists(Catégorie) Then
' Si la catégorie n'existe pas, ajoutez-la au dictionnaire des catégories uniques
CatégoriesUniques(Catégorie) = True
End If
' Vérifiez si la catégorie existe dans le dictionnaire principal
If Not Catégories.Exists(Catégorie) Then
' Si la catégorie n'existe pas, ajoutez-la au dictionnaire principal
Set Catégories(Catégorie) = New Collection
End If
' Ajoutez les valeurs uniques de cette catégorie à la collection
For Each NumCompte In ValeursUniques.Keys
Catégories(Catégorie).Add ValeursUniques(NumCompte)
Next NumCompte
Next i
Next Catégorie
For Each Catégorie In Catégories.Keys
Set LignesUniques = CreateObject("Scripting.Dictionary")
LastRowPL = LastRowPL + 1
wsPL.Cells(LastRowPL, "D").value = Catégorie
wsPL.Cells(LastRowPL, "D").Font.Bold = True
For Each Ligne In Catégories(Catégorie)
If Not LignesUniques.Exists(Ligne) Then
LignesUniques(Ligne) = True
LastRowPL = LastRowPL + 1
wsPL.Cells(LastRowPL, "E").Font.Bold = False
wsPL.Cells(LastRowPL, "E").value = Ligne
End If
Next Ligne
Next Catégorie
LastRow = wsPL.Cells(wsPL.Rows.Count, "E").End(xlUp).Row
LastRowPL = 7
ReDim Totaux(1 To colonne - 13)
For i = 14 To colonne
For RowPL = LastRowPL To LastRow + 1
MaxAnnee = wsPL.Cells(6, i).value
If Cells(RowPL, "D").value <> "" Then
wsPL.Cells(RowPL, "D").Offset(0, (10 + i - 14)).FormulaR1C1 = "=SUMIF(" & "bg_mapping_" & MaxAnnee & ", RC4, " & "bg_solde_credit_" & MaxAnnee & ")"
SommeCatégories = SommeCatégories + wsPL.Cells(RowPL, i).value
ElseIf Cells(RowPL, "E").value <> "" Then
wsPL.Cells(RowPL, "E").Offset(0, (9 + i - 14)).FormulaR1C1 = "=SUMIF(" & "bg_compte_num_" & MaxAnnee & ", RIGHT(RC5,6), " & "bg_solde_credit_" & MaxAnnee & ")"
End If
Next RowPL
Totaux(i - 13) = Totaux(i - 13) + SommeCatégories
SommeCatégories = 0
Next i
LastRowPL = LastRow + 1
wsPL.Cells(LastRowPL, "D").value = "Chiffre d'affaires"
wsPL.Cells(LastRowPL, "D").Font.Bold = True
For i = 1 To colonne - 13
wsPL.Cells(LastRowPL, "D").Offset(0, (9 + i)).value = Totaux(i)
Next iLe code est maintenant complet. Dégueulasse, mais complet. Et il fonctionne
Ca va beaucoup m'aider à retravailler mon code proprement. Un grand, grand merci. Je vous joins mon code définitif pour les spécificités de chaque catégorie et vais me plonger dans votre code pour améliorer le mien
re, c'est bien, mais répéter presque chaque fois la même chose pour chaque catégorie, c'est mieux d'ajouter un boucle en plus.
Oui c'est sûr. Je vais essayer d'appliquer votre boucle dès que j'ai un moment, et que je l'aurai comprise. Merci encore