XL 2013 Optimisation SommeProd (formule ou vba)

GADENSEB

XLDnaute Impliqué
Bonsoir le forum
je gère le fichier ci-joint que je souhaite optimiser :

Opitmiser les sommeprod dans l'onglet SYNTHESE
pour exemple en E6
Code:
=SOMMEPROD((B_Annee=$A6)*(B_Semaine=$C6)*(B_Statut=E$3)*(B_Apayer))
comme le fichier original comporte 10000 lignes le recalcul des sommeprod sur l'ensemble de la page SYNTHESE prends environ 1 minute
poue éviter le recalcul en permance à la saisie des données dans "COMPTES" j'ai bloqué les calculs avec

Code:
Sub Désactivation_App()
    'On désactive les applications (optimisation).
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
End Sub

qui sont ensuite réactivé à l'ouverture de l'onglet SYNTHESE avec
Code:
Sub Activation_App()
    'On réactive les applications (ne pas oublier).
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

avez vous une solution plus fluide?

... on m'impose de ne pas utiliser un TCD ....
 

GADENSEB

XLDnaute Impliqué
hello
me revoila aprés une premiére relacture

code clair et concis, j'adore

petit détail j'ai changé de Feuil2 en Feuil3 car comme le code est presque pret je l'ai placé dans la classeur originel.

je galère sur la boucle For Each Ligne In Groupe.Co pour rajouter les (REEL, BUDGET, Écart), je n'arrive pas à voir ou l’incrémentation des lignes ne va pas...
tu aurais une idée ?


en parallele je travaille sur la gestion de la mise en page
couleur, contour....

J'ai eu une idée pour l'ordonnancement des Comptes puis groupe...... (pour choisir un ordre souhaité)
dans mon fichier définitif j'ai un onglet PARAMETRES puis le permet de lister toutes les infos pour pouvoir ensuite créer mes lisrtes déroulantes, chaque plage de parametres est nommée, par exemple pour les comptes la page est "Tb_P_Comptes"
Donc je je mets un ordonnancement dans une colonne (droite) a côté des comptes, est-ce que l'on ne pourrait pas dire
For Each Compte In Gigogne(Feuil3.[A2], 6, 8, 9, -5) --> suivant l'ordonnacement de ("Tb_P_Comptes",1)
et ainsi de suite pour les groupes, lignes......
ça te parait jouable ?




a+ Seb


Code:
Option Explicit

Private Sub Worksheet_Activate()
Dim Rng As Range, AnDéb As Long, AnFin As Long, M As Long, CMax As Long, T(), L _
    As Long, Compte As SsGr, Groupe As SsGr, LDéb As Long, Ligne As SsGr, _
        BudReel As SsGr, LTot As Long, NonBudget As Boolean, Détail As Variant, An _
        As Long, C As Long
Set Rng = ColUti(Feuil3.[B2])
AnDéb = Year(WorksheetFunction.Min(Rng))
AnFin = Year(WorksheetFunction.Max(Rng))
CMax = (AnFin - AnDéb + 1) * 14 + 4
ReDim T(1 To 5000, 1 To CMax)
For An = AnDéb To AnFin
   For M = 1 To 12: T(1, (An - AnDéb) * 14 + 4 + M) = Format(DateSerial(An, M, 1), "'mmm yy"): Next M, An




For Each Compte In Gigogne(Feuil3.[A2], 6, 8, 9, -5)
   L = L + 5: T(L, 1) = "Compte """ & Compte.ID & """." '------nouveauté : Augementation des lignes entre Comptes
   For Each Groupe In Compte.Co
      L = L + 1: LDéb = L ' On note la ligne du total REEL tous Ligne confondus.
      T(L, 1) = "      Groupe """ & Groupe.ID & """.": T(L, 2) = "Total toutes lignes."
      T(L, 3) = "REEL"
      T(L + 1, 3) = "BUDGET"
      T(L + 2, 3) = "Écart"
      L = L + 4 '------nouveauté : Augementation des lignes entre Groupe.Co
  
  
  
      For Each Ligne In Groupe.Co
      ' Je voudrais rajouter le détail (REEL, BUDGET, Écart) pour chaque Ligne In Groupe.Co  mais il me semble que j'ai crée un décalage de ligne
      ' j'ai du me trompé dans ...T(L + 1 ... ou qqc comme cela
      T(L, 2) = Ligne.ID   '--------------------------------------------------------------------------nouveauté
      T(L, 3) = "REEL" '--------------------------------------------------------------------------nouveauté
      T(L + 1, 3) = "BUDGET" '--------------------------------------------------------------------------nouveauté
      T(L + 2, 3) = "Écart" '--------------------------------------------------------------------------nouveauté
      L = L + 3 '--------------------------------------------------------------------------nouveauté
     For Each BudReel In Ligne.Co
            NonBudget = BudReel.ID <> "BUDGET"
            If NonBudget Then L = L + 1: T(L, 3) = BudReel.ID: LTot = LDéb Else LTot = LDéb + 1
            For Each Détail In BudReel.Co
                   If Détail(15) = "OUI" Then '--------nouveauté : On filtre sur OUI en colonne 15
                          An = Year(Détail(2))
                          C = (An - AnDéb) * 14 + 4 + Month(Détail(2))
                          If NonBudget Then T(L, C) = T(L, C) + Détail(18)
                          T(LTot, C) = T(LTot, C) + Détail(18)
                          C = (An - AnDéb) * 14 + 17
                          If NonBudget Then T(L, C) = T(L, C) + Détail(18)
                          T(LTot, C) = T(LTot, C) + Détail(18)
                   End If '-------------------------nouveauté
            Next Détail
     Next BudReel
     Next Ligne
                   
     
     
     
      For C = 4 To CMax: T(LDéb + 2, C) = T(LDéb, C) - T(LDéb + 1, C): Next C
      Next Groupe
   Next Compte
Me.[A3].Resize(5000, UBound(T, 2)).Value = T '-----nouveauté : Changement de la position du rendu tableau
End Sub
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonjour.
Je m'étais basé sur l'illustration du poste #52 où il me semblait que seuls les REEL de Ligne étaient reproduits. Repars de l'ancien code qui sortait tout et ajoute juste les instructions avec LDéb et LTot. Plus besoin de la variable NonBudget puisque toutes les instructions qui y étaient soumises seront à effectuer systématiquement, cette condition n'étant plus utilisée que pour fixer LTot et on peut faire à la place
LTot = LDéb - (BudReel.Id = "BUDGET")
 
Dernière édition:

GADENSEB

XLDnaute Impliqué
hello
Ce code là ?
wahou chaud .....


Code:
Option Explicit

Private Sub Worksheet_Activate()
Dim Rng As Range, AnDéb As Long, An As Long, CMax As Long, Groupe As SsGr, Ligne As SsGr, BudReel As SsGr
Dim T(), L As Long, C As Long, Détail As Variant
Set Rng = ColUti(Feuil2.[B2])
AnDéb = Year(WorksheetFunction.Min(Rng))
CMax = (Year(WorksheetFunction.Max(Rng)) - AnDéb + 1) * 14 + 4
ReDim T(1 To 500, 1 To CMax)
L = -2
For Each Groupe In Gigogne(Feuil2.[A2], 8, 9, -5)
   L = L + 1
   T(L + 2, 1) = Groupe.Id
   For Each Ligne In Groupe.Co
      L = L + 1
      T(L + 1, 2) = Ligne.Id
      For Each BudReel In Ligne.Co
         L = L + 1
         T(L, 3) = BudReel.Id
         For Each Détail In BudReel.Co
            An = Year(Détail(2))
            C = (An - AnDéb) * 14 + 4 + Month(Détail(2))
            T(L, C) = T(L, C) + Détail(18)
            C = (An - AnDéb) * 14 + 17
            T(L, C) = T(L, C) + Détail(18)
            Next Détail
         Next BudReel
      If Ligne.Count = 2 Then
         L = L + 1
         T(L, 3) = "Écart"
         For C = 5 To CMax: T(L, C) = T(L - 2, C) - T(L - 1, C): Next C
         End If
      Next Ligne
   Next Groupe
T(L + 1, 1) = "RÉCAPITULATIF"
For Each Groupe In Gigogne(Feuil2.[A2], 8, -5)
   L = L + 1
   T(L + 1, 1) = Groupe.Id
   For Each BudReel In Groupe.Co
      L = L + 1
      T(L, 3) = BudReel.Id
      For Each Détail In BudReel.Co
         An = Year(Détail(2))
         C = (An - AnDéb) * 14 + 4 + Month(Détail(2))
         T(L, C) = T(L, C) + Détail(18)
         C = (An - AnDéb) * 14 + 17
         T(L, C) = T(L, C) + Détail(18)
         Next Détail
      Next BudReel
   If Groupe.Count = 2 Then
      L = L + 1
      T(L, 3) = "Écart"
      For C = 5 To CMax: T(L, C) = T(L - 2, C) - T(L - 1, C): Next C
      End If
   Next Groupe
Me.[A30].Resize(L, UBound(T, 2)).Value = T
End Sub
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Oui, ce code là. Enfin sans la boucle avec Gigogne(Feuil2.[A2], 8, -5) puisqu'on ne veut en fin de compte pas de récapitulatif Groupes tous Lignes confondu, ni au début ni à la fin, mais des totaux du Groupe au début de chacun, c'est bien ça. Remarque: dans le récapitulatif, ce seraient les mêmes chiffres.
 

GADENSEB

XLDnaute Impliqué
Bon challenge intéressant et j'aime cela !
Si je résume :


Code:
Boucle 1 sur tous les Comptes
TotalComtpeReel = Somme tous TotalGroupeReel
TotalCompteBudget= Somme tous TotalGroupeBudget
EcartGroupe = TotalComtpeReel - TotalCompteBudget
     Boucle 2 sur tous les Groupes

           Boucle 3 sur toutes les Lignes
             Total 1 Sur REEL
             Total 2 Sur BUDGET
             Ecart = Total 1 - Total 2
           Fin Boucle 3
       TotalGroupeReel = Somme tous Total 1
       TotalGroupeBudget= Somme tous Total 2
       EcartGroupe = TotalGroupeReel - TotalGroupeBudget
     Fin Boucle 2

Fin Boucle 1

C'est cela ?
Sachant que les différents Total sont incrementés dans " T"????
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Oui, si c'est bien le schéma souhaité.
Il faudrait alors aussi noter la ligne au début du Compte dans une autres variable LCpt.
Et peut être ne pas cumuler dans la boucle Détail cette fois mais juste avant le
Next Groupe, en faisant par exemple
For DL = 0 to 2: for C = 5 To Cmax: T(LCpt + DL, C) = T(LCpt + DL, C) + T(LDéb + DL, C): Next C, DL
Peut être vaudrait il mieux rebaptise LDéb en LGrp parce que comme il y aura plusieurs lignes de début, avec LDéb on ne saura plus de quoi c'est la ligne de début…

Edit: il vaut peut être quand même mieux repartir de l'algorithme du poste #59: il y a déjà plus de choses qu'on veut, il y a juste des choses en trop qu'on ne veut pas, qui sautent la sortie des BudReel.Id "BUDGET", mais pas leur cumul au niveau total Groupe
 
Dernière édition:

GADENSEB

XLDnaute Impliqué
Voila ou j'en suis ....
avec un bug sur
Code:
 For DL = 0 To 2: For C = 5 To CMax: T(LCpt + DL, C) = T(LCpt + DL, C) + T(LGrp + DL, C): Next C, DL
mais sans message explicatif

Code:
Option Explicit

Private Sub Worksheet_Activate()
Dim Rng As Range, AnDéb As Long, AnFin As Long, M As Long, CMax As Long, T(), L As Long, _
    Compte As SsGr, Groupe As SsGr, LGrp  As Long, Ligne As SsGr, BudReel As SsGr, _
    LTot As Long, NonBudget As Boolean, Détail As Variant, An As Long, C As Long, LCpt As Long, DL As Long
Set Rng = ColUti(Feuil3.[B2])
AnDéb = Year(WorksheetFunction.Min(Rng))
AnFin = Year(WorksheetFunction.Max(Rng))
CMax = (AnFin - AnDéb + 1) * 14 + 4
ReDim T(1 To 5000, 1 To CMax)
For An = AnDéb To AnFin: For M = 1 To 12
   T(1, (An - AnDéb) * 14 + 4 + M) = Format(DateSerial(An, M, 1), "'mmm yy"): Next M, An
For Each Compte In Gigogne(Feuil3.[A2], 6, 8, 9, -5)
   L = L + 2: T(L, 1) = "Compte """ & Compte.ID & """."
   For Each Groupe In Compte.Co
      L = L + 1: LGrp = L  ' On note cette ligne de début comme celle du total groupe REEL.
      T(L, 1) = "      Groupe """ & Groupe.ID & """.": T(L, 2) = "Total toutes lignes."
      T(L, 3) = "REEL"
      T(L + 1, 3) = "BUDGET"
      T(L + 2, 3) = "Écart"
      L = L + 3
      For Each Ligne In Groupe.Co
         For Each BudReel In Ligne.Co
            NonBudget = BudReel.ID <> "BUDGET"
            If NonBudget Then
               L = L + 1
               T(L, 2) = Ligne.ID
               T(L, 3) = BudReel.ID
               LTot = LGrp  ' Ligne total Groupe REEL
            Else
               LTot = LGrp + 1  ' Ligne total Groupe BUDGET
               End If
            For Each Détail In BudReel.Co
               If Détail(15) = "OUI" Then
                  An = Year(Détail(2))
                  C = (An - AnDéb) * 14 + 4 + Month(Détail(2))
                  If NonBudget Then T(L, C) = T(L, C) + Détail(18)
                  T(LTot, C) = T(LTot, C) + Détail(18) ' Cumul en ligne total Groupe.
                  C = (An - AnDéb) * 14 + 17
                  If NonBudget Then T(L, C) = T(L, C) + Détail(18)
                  T(LTot, C) = T(LTot, C) + Détail(18) ' Cumul en ligne total Groupe.
                  End If: Next Détail
            Next BudReel
         Next Ligne
      For C = 4 To CMax: T(LGrp + 2, C) = T(LGrp, C) - T(LGrp + 1, C): Next C
      For DL = 0 To 2: For C = 5 To CMax: T(LCpt + DL, C) = T(LCpt + DL, C) + T(LGrp + DL, C): Next C, DL
      Next Groupe
   Next Compte
Me.[A3].Resize(5000, UBound(T, 2)).Value = T
End Sub

Qu'est ce que tu en penses ?

Bonne am
ps n°1 : j'ai changé la feuille en feuil3
et Me.[A30].Resize(5000, UBound(T, 2)).Value = T en Me.[A3].Resize(5000, UBound(T, 2)).Value = T

ps n°2 qu'est ce que tu penses de mon idée en post 61 ?
J'ai eu une idée pour l'ordonnancement des Comptes puis groupe...... (pour choisir un ordre souhaité)
dans mon fichier définitif j'ai un onglet PARAMETRES puis le permet de lister toutes les infos pour pouvoir ensuite créer mes lisrtes déroulantes, chaque plage de parametres est nommée, par exemple pour les comptes la page est "Tb_P_Comptes"
Donc je je mets un ordonnancement dans une colonne (droite) a côté des comptes, est-ce que l'on ne pourrait pas dire
For Each Compte In Gigogne(Feuil3.[A2], 6, 8, 9, -5) --> suivant l'ordonnacement de ("Tb_P_Comptes",1)
et ainsi de suite pour les groupes, lignes......
ça te parait jouable ?
 

Dranreb

XLDnaute Barbatruc
Manque l'initialisation de LCpt après For Each Compte
Il faut tout un groupe d'instructions très analogue à celui qu'il y a derrière le For Each Groupe, sauf qu'on y initialise LCpt au lieu de LGrp.

Rien compris au deuxième point du poste 61. Il faudrait virer tous ces noms absurdes et faire subir à la plage de données une mise sous forme de tableau (menu Accueil, groupe Styles). Ça permettrait d'accéder aux colonnes par leurs titres en garantissant qu'elle ont toujours le nombre de lignes qu'il faut.

S'il y a des des codes quelque part pour les Compte, Groupe, et Ligne, ces sont ceux là qu'il devrait y avoir dans les données plutôt que leurs libellés. Ou alors les deux: Code — Libellé
 
Dernière édition:

GADENSEB

XLDnaute Impliqué
Fait !
mais incompatibilité de type

sur
Code:
      For DL = 0 To 2: For C = 5 To CMax: T(LCpt + DL, C) = T(LCpt + DL, C) + T(LGrp + DL, C): Next C, DL



Code:
Option Explicit

Private Sub Worksheet_Activate()
Dim Rng As Range, AnDéb As Long, AnFin As Long, M As Long, CMax As Long, T(), L As Long, _
    Compte As SsGr, Groupe As SsGr, LGrp  As Long, Ligne As SsGr, BudReel As SsGr, _
    LTot As Long, NonBudget As Boolean, Détail As Variant, An As Long, C As Long, LCpt As Long, DL As Long
Set Rng = ColUti(Feuil3.[B2])
AnDéb = Year(WorksheetFunction.Min(Rng))
AnFin = Year(WorksheetFunction.Max(Rng))
CMax = (AnFin - AnDéb + 1) * 14 + 4
ReDim T(1 To 5000, 1 To CMax)
For An = AnDéb To AnFin: For M = 1 To 12
   T(1, (An - AnDéb) * 14 + 4 + M) = Format(DateSerial(An, M, 1), "'mmm yy"): Next M, An
For Each Compte In Gigogne(Feuil3.[A2], 6, 8, 9, -5)

      L = L + 1: LCpt = L  ' On note cette ligne de début comme celle du total groupe REEL.
      T(L, 1) = Compte.ID & """.": T(L, 2) = "Total toutes lignes."
      T(L, 3) = "REEL"
      T(L + 1, 3) = "BUDGET"
      T(L + 2, 3) = "Écart"
      L = L + 3



   L = L + 2: T(L, 1) = "Compte """ & Compte.ID & """."
   For Each Groupe In Compte.Co
      L = L + 1: LGrp = L  ' On note cette ligne de début comme celle du total groupe REEL.
      T(L, 1) = "      Groupe """ & Groupe.ID & """.": T(L, 2) = "Total toutes lignes."
      T(L, 3) = "REEL"
      T(L + 1, 3) = "BUDGET"
      T(L + 2, 3) = "Écart"
      L = L + 3
      For Each Ligne In Groupe.Co
         For Each BudReel In Ligne.Co
            NonBudget = BudReel.ID <> "BUDGET"
            If NonBudget Then
               L = L + 1
               T(L, 2) = Ligne.ID
               T(L, 3) = BudReel.ID
               LTot = LGrp  ' Ligne total Groupe REEL
            Else
               LTot = LGrp + 1  ' Ligne total Groupe BUDGET
               End If
            For Each Détail In BudReel.Co
               If Détail(15) = "OUI" Then
                  An = Year(Détail(2))
                  C = (An - AnDéb) * 14 + 4 + Month(Détail(2))
                  If NonBudget Then T(L, C) = T(L, C) + Détail(18)
                  T(LTot, C) = T(LTot, C) + Détail(18) ' Cumul en ligne total Groupe.
                  C = (An - AnDéb) * 14 + 17
                  If NonBudget Then T(L, C) = T(L, C) + Détail(18)
                  T(LTot, C) = T(LTot, C) + Détail(18) ' Cumul en ligne total Groupe.
                  End If: Next Détail
            Next BudReel
         Next Ligne
      For C = 4 To CMax: T(LGrp + 2, C) = T(LGrp, C) - T(LGrp + 1, C): Next C
      For DL = 0 To 2: For C = 5 To CMax: T(LCpt + DL, C) = T(LCpt + DL, C) + T(LGrp + DL, C): Next C, DL
      Next Groupe
   Next Compte
Me.[A3].Resize(5000, UBound(T, 2)).Value = T
End Sub


Pour la deuxiéne partie, i je transforme ma BDD de données en TABLEAU, cela fait beugé mes macro qui viennent modifié/insérer les données dans la BDD
 

GADENSEB

XLDnaute Impliqué
voila le résultat des espions

upload_2017-8-9_16-43-53.png


pour le code "old school" Lol je veux pa le toucher pr l'instant, on verra dans une deuxième partie ;-)

pour illutrer mon propos dans mon onglet PARAMETRES je définie les listes
par exemple, pour les comptes, la plage s'appelle Tb_P_Comptes (colonne 1)que je pourrai ordonnancer selon l'envie (colonne n)2)

upload_2017-8-9_16-46-35.png

du coup en faisant référence à la plage Tb_P_Comptes et son ordonnancement a coté on pourrait ordonnancer l'ordre de calcul des COMPTES , puis GROUPE ....
J’espère
avoir été plus clair
 

Dranreb

XLDnaute Barbatruc
Non ça c'est le résultat des espions quand rien ne s'exécute. C'est le résultat en débogage quand ça plante qui m'intéresse.
Il faut s'arranger d'une manière ou d'une autre pour que Gigogne ait les N à traiter et pas les COMPTE.
 

Dranreb

XLDnaute Barbatruc
Zut, c'est pas DK c'est DL. Faute de frappe de ma part.
C c'est le numéro de colonne où on cumule. C'est 14 * la différence entre l'année et l'année de début + 4 + le mois. Mais dans la boucle on cumule toutes les colonnes.
Gigogne ne peut pas traiter les argument autrement que dans leur propre ordre. Par conséquent il faut qu'il ait à traiter en tant qu'arguments leurs rangs dans l'ordre souhaité au lieu de leurs désignations. Pour cela il faut que les données qu'il traite les contiennent, temporairement ou de façon définitive.
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 090
Messages
2 085 210
Membres
102 820
dernier inscrit
SIEG68