XL 2013 Optimisation SommeProd (formule ou vba)

GADENSEB · 29 Janvier 2017

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 · 9 Août 2017

et voila

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

POATY · 10 Août 2017

Bonsoir, j'ai besoin d'aide ; je voudrais savoir comment mettre un format à toutes mes text box sachant qu'il y en a 144 ; j'aimerais passer par une boucle for mais je butte quelques heure sur le problème.

Dranreb · 10 Août 2017

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.

GADENSEB · 10 Août 2017

@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 ......

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?

Dranreb · 10 Août 2017

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.

GADENSEB · 10 Août 2017

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

Dranreb · 10 Août 2017

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.

GADENSEB · 10 Août 2017

heuuu là j'ai pas compris....

Dranreb · 10 Août 2017

Les boucles internes doivent plus ressembler à ce que je faisais dans l'autre code, celui que tu reproduit au poste #63

GADENSEB · 10 Août 2017

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 ?

Dranreb · 10 Août 2017

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 ?

GADENSEB · 10 Août 2017

Mince mauvai copié collé pour NONBUDGET

Sisisi
pour COMPTES / GROUPE / LIGNE (en cascade) il faut bien REEL / BUDGET / Ecart

Dranreb · 10 Août 2017

Débrouille toi alors. S'il n'y sont pas tous les deux dans les donnée pour un même Ligne, qu'est ce que tu veux qu'on y fasse ?

GADENSEB · 10 Août 2017

Ben s'ils n'y sont pas (Budget ou reel) c'est pas grave on met 0 à la place...

Dranreb · 10 Août 2017

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.

Effectuez une recherche sur Excel Downloads...

XL 2013 Optimisation SommeProd (formule ou vba)

GADENSEB

XLDnaute Impliqué

GADENSEB

XLDnaute Impliqué

POATY

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

GADENSEB

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

GADENSEB

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

GADENSEB

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

GADENSEB

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

GADENSEB

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

GADENSEB

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums