XL 2013 Optimisation SommeProd (formule ou vba)

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
GADENSEB

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 ....
 
Trier par date Trier par votes
et voila
upload_2017-8-9_22-55-48.png

a mon avis cela vient des accent sur les mois
dans ma bdd ils sont traités sans les accents avec
Code: 
Function sansAccent(chaine)
  'Remplace les accents des lettres avec accent
  codeA = "ÉÈÊËÔéèêëàçùôÛûïî"
  codeB = "EEEEOeeeeacuoUuii"
  temp = chaine
  For i = 1 To Len(temp)
    p = InStr(codeA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
  Next
  sansAccent = temp
End Function
 
Vote positif 0 Vote négatif
POATY, ouvrez votre propre discussion pour ce sujet s'il vous plait.
GADENSEB, non ce n'est pas ça. Il faudrait mettre L au moins à 1 après la mise en place des dates en titres, sinon, L valant 0 au départ, le 1er L = L + 1 le met à 1, de sorte qu'on essaye de cumuler des montants sur ces dates au lieu de les cumuler sur des postes vides.
 
Vote positif 0 Vote négatif
@POATY : j'avais un code là dessus, si je le retrouve, je le renvoi.

@Dranreb : apparement ca tourne

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))
L = 1
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
Sauf que cela ne me renvoi plus les REEL / BUDGET / ECART pour chaque LIGNE de dépenses
à l'intérieur d'un groupe
Exemple : Groupe GESTION lignes: Courses, frais banque ......

upload_2017-8-10_8-4-26.png


il faut virer "NonBudget" ..... c'est bien cela ?

Petite amélioration :
La colonne 13 Correspond au cumul de 1 a 12
et la colonne 14 = colonne 13 + colonne 0

je suppose qu'il faut faire ces calculs aprés Next Compte?
 
Vote positif 0 Vote négatif
Bonjour.
Oui, il faut virer NonBudget
Non, le calcul des colonnes C = 18 To CMax Step 14 devrait se faire avant Next BudReel puisqu'on changera de ligne pour le suivant.
C'est vrai qu'on pourrait aussi faire les cumuls des 12 mois de chaque année à cet endroit plutôt qu'à chaque détail. À voir.
 
Dernière édition:
Vote positif 0 Vote négatif
Comme cela ????
J'ai l'impression qu'il ya un truc qui va pas ....
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))
L = 1
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
             
      T(L, 2) = Ligne.ID
      T(L, 3) = "REEL"
      T(L + 1, 3) = "BUDGET"
      T(L + 2, 3) = "Écart"
      L = L + 3
       
             
               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
 
Vote positif 0 Vote négatif
Oui, au lieu de LTot = LGrp il faut LTot = LGrp - (BudReel.Id = "BUDGET").
Et il faut remettre la fabrication de la ligne "Écart" avant Next Ligne s'il y avait bien 2 BudReel, comme dans l'autre code. Et on ne peut pas prévoir d'avance les 3 lignes au niveau Ligne parce qu'on ne peut pas être tout à fait sûr qu'on trouvera effectivement à la fois un BudReel.Id = "REEL" et un BudReel.Id = "BUDGET", alors on les produit au fur et à mesure qu'on les trouve en faisant simplement L = L + 1 pour chaque.
 
Dernière édition:
Vote positif 0 Vote négatif
heuuu je suis totalement perdu lol
on reprend calmement si possible
on bosse sur ce code

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))
L = 1
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
             
      T(L, 2) = Ligne.ID
      T(L, 3) = "REEL"
      T(L + 1, 3) = "BUDGET"
      T(L + 2, 3) = "Écart"
      L = L + 3
       
             
               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



mais en modifiant les boucles pour qu'elles ressemblent à celà

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

c'est bien cela ?

Je porpose de "purifier" le premier code, dans un premier temps, pour éclaircir les choses....

que doit on éliminer/réorganiser ?
 
Vote positif 0 Vote négatif
Non. If faut revoir la boucle For Each Ligne aussi et ne plus utiliser NonBudget puisque tu les veux aussi les budget. Et il faut fabriquer une ligne Écart à la fin seulement s'il y avait les deux. Comme dans l'autre code, quoi…
On est bien d'accord que pour un Ligne, s'il manque BudReel.Id "REEL" ou "BUDGET" il ne faut pas produire le "Écart" non plus ?
 
Vote positif 0 Vote négatif
Alors il faut définir un LLig aussi pour le début ligne et plusieurs sortes de LTot pour y mettre aussi LLig ou LLig + 1 selon que BudReel.Id est "REEL" ou "BUDGET" et ne plus du tout utiliser L pour cumuler, seulement pour compter le nombre de lignes renseignées et fixer les L de débuts et donc de "REEL" de chaque niveau.
J'en ai marre de cette application. Vraiment, débouille toi maintenant.
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

I
  • Question Question
Microsoft 365 gestion des erreurs vba Excel
Réponses
2
Affichages
375
iliess
I
D
  • Question Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
879
crocrocro
C
S
  • Question Question
Microsoft 365 Amélioration d'un code
Réponses
6
Affichages
677
Stéfane
S
Fredox
  • Question Question
XL 2019 [Résolu] VBA SommeProd, résultat en formule
Réponses
2
Affichages
827
Fredox
Fredox
S
  • Résolu(e)
Microsoft 365 Optimisation / accélération execution code VBA
Réponses
13
Affichages
2 K
spike29
S
S
  • Question Question
Boucle sur envoi automatique
Réponses
3
Affichages
1 K
Solo_Wing75
S
S
  • Question Question
VBA - Envoyer l'onglet actif + un autre en pdf
Réponses
5
Affichages
3 K
Phil69970
Phil69970
M
  • Question Question
XL 2016 Collection object
Réponses
1
Affichages
824
mido21
M
T
  • Question Question
XL 2016 VBA "traduction" de validation de données
2
Réponses
16
Affichages
3 K
Turgon
T
S
  • Question Question
XL 2010 Envoi d'une feuille spécifique par mail via VBA
Réponses
9
Affichages
2 K
Lone-wolf
Lone-wolf
S
  • Question Question
XL 2010 Ajustement code VBA + Envoi mail multiple
Réponses
1
Affichages
808
Saumon80
S
P
  • Question Question
XL 2010 Transformer une formule d'extraction et filtrage par une macro
Réponses
4
Affichages
1 K
pompier83
P
A
  • Question Question
MACRO : Formule ne s'étend pas
Réponses
2
Affichages
1 K
Alex74330
A
M
  • Question Question
VBA - envoyer un mail outlook via macro excel
Réponses
4
Affichages
2 K
Moe
M
A
  • Question Question
[Résolu] Accélérer rechercheV
Réponses
7
Affichages
2 K
adel53
A
T
  • Question Question
Utilisation de constantes prédefinies dans une formule
Réponses
4
Affichages
759
Tini3
T
C
  • Question Question
sauvegarder données avec calendrier + vba
Réponses
0
Affichages
2 K
cpt
C
F
  • Question Question
Code VBA pour un onglet sommaire 'mobile' mais bloquant les fonctions Excel
Réponses
10
Affichages
2 K
Fou75
F
S
  • Question Question
Macro - Procedure Workbook_sheetchange - cacher ligne en dessous TCD
Réponses
1
Affichages
920
sim
S
Q
  • Question Question
Excel 2007 Macro VBA from Ron de Bruin.
Réponses
1
Affichages
7 K
Efgé
Efgé
Retour