XL 2013 Optimisation SommeProd (formule ou vba)

[GADENSEB]

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

=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

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

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

 

[Dranreb]

Bonsoir.
Qu'en est-il de cette discussion ?
Au fait j'ai un nouveau système de classement légèrement plus performant, utilisé par une fonction Gigogne qui remplace GroupOrg. Tout aussi facile à utiliser. Idéal pour des synthèses.
Et toujours beaucoup plus rapide que des SOMMEPROD, bien évidemment.

 

[GADENSEB]

Hello
Effectivement cette discussion est passée aux travers de ma mémoire...
Disons que now c'est la bonne occsaion d'essayer tes fonctions... ;-)

 

[Dranreb]

Bonjour.
En fait, après analyse, il semblerait qu'on n'en ait pas trop besoin dans le cas du fichier joint, si tout est classé par date.
Cette procédure semble faire l'affaire :

Private Sub Worksheet_Activate()
Dim PlgSyn As Range, TSyn(), C&, TDon(), DicTT As New Dictionary, LE&, LS&
TSyn = [A3:K3].Value
For C = 5 To 11: DicTT(TSyn(1, C)) = C: Next C
Set PlgSyn = Intersect([A6:K1000000], UsedRange)
TSyn = PlgSyn.Resize(, 4).Value
ReDim Preserve TSyn(1 To UBound(TSyn, 1), 1 To 11)
TDon = [Table2].Value
LS = 1
For LE = 1 To UBound(TDon, 1)
   While TSyn(LS + 1, 2) <= TDon(LE, 18): LS = LS + 1: Wend
   C = DicTT(TDon(LE, 26))
   TSyn(LS, C) = TSyn(LS, C) + TDon(LE, 25)
   Next LE
PlgSyn.Value = TSyn
PlgSyn.Cells(UBound(TSyn, 1), "E").Resize(, 7).FormulaR1C1 = "=SUM(R6C:R[-1]C)"
End Sub

Cochez la Microsoft Scripting Runtime.

 

[GADENSEB]

Hello
Le.code marche nickel
.....Sur mon fichier test et pas sur l'original.....Grrrrrrr
Je pointe les différences...

Merci en tt cas

 

[GADENSEB]

j'ai une erreur sur


TSyn(LS, C) = TSyn(LS, C) + TDon(LE, 25)

..... je pige pas

 

[Dranreb]

Bonsoir.
Il est assez probable que la colonne 26 du tableau de données contienne autre chose que ce qui est prévu dans les titres de la synthèse. Si c'est le cas, C vaut 0.
Vous pouvez ajouter une vérification :

For LE = 1 To UBound(TDon, 1)
   While TSyn(LS + 1, 2) <= TDon(LE, 18): LS = LS + 1: Wend
   If DicTT.Exists(TDon(LE, 26)) Then
      C = DicTT(TDon(LE, 26))
      TSyn(LS, C) = TSyn(LS, C) + TDon(LE, 25)
   Else: MsgBox """" & TDon(LE, 26) & """ non prévu dans les titres.", _
      vbCritical, "Synthèse": Exit Sub: End If
   Next LE

 

[GADENSEB]

Hello
Cela à fonctionner, j'ai trouvé une erreur que j'ai corrigé.
Par contre, l'erreur "9" persiste....

 

[Dranreb]

Bonjour.
Avez vous ajouté le test de vérification ?

 

[GADENSEB]

oui oui
il m'avait trouvé une erreur dans la colonne 29
une cellule était vide

 

[Dranreb]

Ben alors il ne peut plus y avoir de d'erreur 9 sur cette instruction puisqu'elle n'est plus exécutée.
À moins que ce soit LS qui dépasse ?
Apprenez à déboguer un peu, et à corriger de vous même ce qui ne va pas.

 

[Dranreb]

Une version avec des sécurités supplémentaires, à tester :

Private Sub Worksheet_Activate()
Dim PlgSyn As Range, TSyn(), C&, TDon(), DicTT As New Dictionary, LE&, LS&, L&
TSyn = [A3:K3].Value
For C = 5 To 11: DicTT(TSyn(1, C)) = C: Next C
Set PlgSyn = Intersect([A6:K1000000], UsedRange)
TSyn = PlgSyn.Resize(, 4).Value
ReDim Preserve TSyn(1 To UBound(TSyn, 1), 1 To 11)
TDon = [Table2].Value
LS = 1
For LE = 1 To UBound(TDon, 1)
   If LE > 1 Then If TDon(LE, 18) < TDon(LE - 1, 18) Then MsgBox "Date déclassée dans TDon", _
         vbCritical, "Synthèse": Application.Goto [Table2].Cells(LE, 18): Exit Sub
   For L = LS + 1 To UBound(TSyn) - 1
      If TSyn(L, 2) < TSyn(LS, 2) Then MsgBox "Date déclassée dans TSyn", _
         vbCritical, "Synthèse": Application.Goto PlgSyn.Cells(L, 2): Exit Sub
      If TSyn(L, 2) > TDon(LE, 18) Then Exit For
      LS = L: Next L
   If DicTT.Exists(TDon(LE, 26)) Then
      C = DicTT(TDon(LE, 26))
      TSyn(LS, C) = TSyn(LS, C) + TDon(LE, 25)
   Else: MsgBox """" & TDon(LE, 26) & """ non prévu dans les titres.", _
      vbCritical, "Synthèse": Application.Goto [Table2].Cells(LE, 26): Exit Sub: End If
   Next LE
PlgSyn = TSyn
PlgSyn.Cells(UBound(TSyn, 1), "E").Resize(, 7).FormulaR1C1 = "=SUM(R6C:R[-1]C)"
End Sub

 

[GADENSEB]

Je cherches aussi en parallèle
Là du coup j'ai ce message d'erreur
Je peux créer un classement par date (colonne R)
du coup avec mon qui classe par la colonne R
Call TridonnéesEcheance c'est pas mieux......

Private Sub Worksheet_Activate()

Call TridonnéesEcheance

Dim PlgSyn As Range, TSyn(), C&, TDon(), DicTT As New Dictionary, LE&, LS&, L&
TSyn = [A3:K3].Value
For C = 5 To 11: DicTT(TSyn(1, C)) = C: Next C
Set PlgSyn = Intersect([A6:K1000000], UsedRange)
TSyn = PlgSyn.Resize(, 4).Value
ReDim Preserve TSyn(1 To UBound(TSyn, 1), 1 To 11)
TDon = [Table2].Value
LS = 1
For LE = 1 To UBound(TDon, 1)
   If LE > 1 Then If TDon(LE, 18) < TDon(LE - 1, 18) Then MsgBox "Date déclassée dans TDon", _
         vbCritical, "Synthèse": Application.Goto [Table2].Cells(LE, 18): Exit Sub
   For L = LS + 1 To UBound(TSyn) - 1
      If TSyn(L, 2) < TSyn(LS, 2) Then MsgBox "Date déclassée dans TSyn", _
         vbCritical, "Synthèse": Application.Goto PlgSyn.Cells(L, 2): Exit Sub
      If TSyn(L, 2) > TDon(LE, 18) Then Exit For
      LS = L: Next L
   If DicTT.Exists(TDon(LE, 26)) Then
      C = DicTT(TDon(LE, 26))
      TSyn(LS, C) = TSyn(LS, C) + TDon(LE, 25)
   Else: MsgBox """" & TDon(LE, 26) & """ non prévu dans les titres.", _
      vbCritical, "Synthèse": Application.Goto [Table2].Cells(LE, 26): Exit Sub: End If
   Next LE
PlgSyn = TSyn
PlgSyn.Cells(UBound(TSyn, 1), "E").Resize(, 7).FormulaR1C1 = "=SUM(R6C:R[-1]C)"
End Sub

 

[Dranreb]

Bon ben vous avez votre réponse: la cellule responsable est sélectionnée juste après.
Supprimez toutes les lignes qui ne porteraient aucune date.

 

[gosselien]

Bonjour,

un tcd ne peut pas convenir ?

P.