XL 2013 Optimisation SommeProd (formule ou vba)

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
GADENSEB

GADENSEB

XLDnaute Impliqué
@ Ce lien n'existe plus : Ben on m'impose de ne pas utiliser de TCD .... je sais c ****

@ Dranreb : Ok j'ai compris le système.
Par contre comme Table2 est un tableau excel qui va jusqu’à 65000 lignes, j'ai fatalement des lignes avec des dates vides (c pas moi qui suit à l'origine de ce tableau)
du coup j'essaye de passer une variable TableD pour aller jusqu’à la dernière ligne vide... mais pas glorieux encore.... j'y suis presque j’ai confiance !!! ;-)



Code: 
Private Sub Worksheet_Activate()


Dim PlgSyn As Range, TSyn(), C&, TDon(), DicTT As New Dictionary, LE&, LS&, L&, TableD()

TableD = Worksheets("COMPTES").Range("A2:AC" & Range("A" & Rows.Count).End(xlUp).Row)


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 = [TableD].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
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
GADENSEB à dit:
Table2 est un tableau excel qui va jusqu’à 65000 lignes
Cliquez pour agrandir...
Ah non ! C'est à vous d'imposer à tout le monde de ne laisser que des lignes utiles dans le tableau. En commençant par supprimer d'autorité celles qui ne servent à rien, sans demander l'avis à personne ! Sinon ça ne sert à rien de le laisser sous forme de tableau, ça perd tout intérêt.
Et programmez certaines choses correctement, en n'utilisant plus les End(xlUp) :
VB: 
Sub TridonnéesEcheance()
Dim LO As ListObject
Set LO = ThisWorkbook.Worksheets("COMPTES").ListObjects("Table2")
With LO.Sort
   .SortFields.Clear
   .SortFields.Add Key:=LO.ListColumns("ECHEANCE").Range, _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   .Header = xlYes: .MatchCase = False: .Orientation = xlTopToBottom
   .SortMethod = xlPinYin: .Apply: End With
End Sub
VB: 
Private Sub VersLeBas_Click()
With Me.ListObjects(1)
   Application.Goto .ListRows(.ListRows.Count).Range
   End With
End Sub
 
Vote positif 0 Vote négatif
S

Si...

XLDnaute Barbatruc
Salut


Quand j’ai un Tableau (nommé Table2 par exemple), j’utilise plutôt la syntaxe suivante

'Tri croissant du tableau en fonction de la colonne de titre ECHEANCE
Code: 
Sub TridonnéesEcheance()
  [Table2].Sort [Table2[ECHEANCE]].Item(1, 1), Header:=1
End Sub
'pour sélectionner la dernière ligne vide ou pas du tableau
Code: 
Private Sub VersLeBas_Click()
    [Table2].Rows([Table2].Rows.Count).Select
End Sub
'dernière ligne non vide de la colonne 4 du tableau
Code: 
Private Sub VersLafin_Click()
  [Table2].Columns(4).Rows([Table2].Rows.Count).End(xlUp).Select
End Sub


Comme me le disait Chris ;) il y a peu : « chacun fait ce qu'il veut !»
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Oui, ça à l'air bon, même si moi j'ai plutôt encore tendance à utiliser les propriétés du ListObject.
Surtout si je peux être amené à l'utiliser en différents endroits, pour éviter de l'évaluer à chaque fois.
gosselien à dit:
Pourquoi ne pas utiliser ça ?
Cliquez pour agrandir...
Parce qu'on a directement le ListObject.ListRows.Count alors plus besoin de cette vieille gymnastique absurde des End(xlUp)
Surtout qu'en plus on n'en a même pas besoin pour ajouter une ligne après la dernière: c'est .ListRows.Add.Range qui représente la plage couvrant la nouvelle ligne, on n'a même pas besoin de savoir laquelle c'est, on s'en fout.
 
Vote positif 0 Vote négatif
GADENSEB

GADENSEB

XLDnaute Impliqué
ME revoila .... avec un peut de retard

@ Dranreb : Je suis dacocord j'impose comment formater le fichier , j'ai viré les lignes vides et cela va bcp mieux .... 2500 lignes remplies celava mieux

@Ce lien n'existe plus : Pas mal les codes, je vais les tester

Merci en tt cas de votre aide !!

a bientot
 
Vote positif 0 Vote négatif
GADENSEB

GADENSEB

XLDnaute Impliqué
@ Le Forum et tout le monde

@Danreb
ton code est vraiment super !!!
Il marche au poil

et du coup, je me dis que l'on pourrait encore plus le pousser.....
j'ai poster sur developpez.net ça :

HTML: 
https://www.developpez.net/forums/d1645029/logiciels/microsoft-office/excel/macros-vba-excel/extraction-d-bdd-commentaire/

j'alterne entre les deux forums pour ne pas paraître pénible LOL

Je réexplique la chose
Je voudrais a la liste (dans un commentaire) des données extraire de la BDD qui ont servi à faire la calcul issu de ton code

.... je sais pas si je suis clair....

Du style cela :
upload_2017-3-6_13-1-41.png

Colonne F : Tiers Colonne O : TTC Colonne Q : HT

je sais que le code pour les commentaires est :

Code: 
 If .[E6].Comment Is Nothing Then .[E6].AddComment
      .[E6].Comment.Text Text:=bobo
      .[E6].Comment.Shape.TextFrame.AutoSize = True

mais comment remplir en mutilicolonne le commentaire. ..là je sais pas ... avec ton code se serait avec PlgSyn ????

J'ai pensé aussi avec une list box ......

qu'est-ce que tu en penses???
bonne am

Seb
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Je pense qu'on ne va pas pouvoir faire un cadrage bien propre dans un commentaire. Mais on peut toujours y mentionner les informations. Ça risque de ralentir un peu. Il en faudrait sur chaque cellule qui porte un montant ? Comme ça :
VB: 
Private Sub Worksheet_Activate()
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)
On Error Resume Next
Do: Me.Comments(1).Delete: Loop Until Err
On Error GoTo 0
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)
      ModifierCommentaire PlgSyn(LS, C), TDon(LE, 6) & ": " & 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)"



  With Worksheets("SYNTHESE")
    Range("A:S").Select 'à préciser
    ActiveWindow.Zoom = True
    Range("B4").Select
  End With
End Sub

Sub ModifierCommentaire(ByVal Cel As Range, ByVal ZLigne As String)
Dim Cmt As Comment
Set Cmt = Cel.Comment
If Cmt Is Nothing Then Cel.AddComment ZLigne: Exit Sub
Cmt.Text Cmt.Text & vbLf & ZLigne
End Sub
 
Vote positif 0 Vote négatif
GADENSEB

GADENSEB

XLDnaute Impliqué
Tout simplement parfait
et cela ne ralenti quasiment pas ....
Petite amélioration :
- Echapper les lignes dont la colonne Y =""
-

Le format des chiffres est bizarre : avec 12 ou 13 chiffres aprés la virgules... pourrait-on faire du ####.00 €
avec séparateur des miliers ?
Est-ce que le pb vient de la BDD en elle-mme qui est mal formaté au niveau des chiffres ?


Merci encore c'est génial
 
Vote positif 0 Vote négatif
GADENSEB

GADENSEB

XLDnaute Impliqué
Hello Danreb
Donc code précédent est vraiment génial !
Il fonctionne au poil

Code: 
Private Sub Worksheet_Activate()

  With Worksheets("SYNTHESE")
  Range("A:t").Select 'à préciser
  ActiveWindow.Zoom = True
  Range("B4").Select
  End With

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)
On Error Resume Next
Do: Me.Comments(1).Delete: Loop Until Err
On Error GoTo 0
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)
      If TDon(LE, 25) <> "" Then
      ModifierCommentaire PlgSyn(LS, C), TDon(LE, 6) & ": " & Format$(TDon(LE, 25), "0.00") & " €"
      End If
   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


Du coup, je voudrais l'adapter au fichier joint
j'avoue que je ne sais pas par ou prendre le truc.

Le fichier se découpe en plusieurs section comme celle de "REVENUS"

Il ya environ 600 calculs en plus du type

Code: 
=SOMMEPROD((C$1>0)*(Tb_B_COMPTE="COURANT")*(Tb_B_ANNEE=2015)*(Tb_B_MOIS=C$3)*(Tb_B_BUDGETREEL="REEL")*(Tb_B_GROUPE="REVENUS")*(Tb_B_LIGNE=$A14)*(Tb_B_BQ="OUI")*(Tb_B_DEBITCREDIT))
Cale représente environ 3 minutes de calcul pour tt calculer à chaque fois ..... c long lol....

Dans le premier fichier il existe une table "Table2 " mais dans celui-ci :
11000 lignes, colonne A à S

--> Dois-je nommer la plage de données en premier ?

puis comment remplacer (pour exemple C14) :
Code: 
=SOMMEPROD((C$1>0)*(Tb_B_COMPTE="COURANT")*(Tb_B_ANNEE=2015)*(Tb_B_MOIS=C$3)*(Tb_B_BUDGETREEL="REEL")*(Tb_B_GROUPE="REVENUS")*(Tb_B_LIGNE=$A14)*(Tb_B_BQ="OUI")*(Tb_B_DEBITCREDIT))

Et tt cela doit être répété sur toutes les années 2015 2016 2017 et évolutif sur les années futures .

Aurez-tu une idée ?

Bonne AM
 

Pièces jointes

  • BUDGET - SYNTHESE 2017 - TEST OPTIMISATION SOMMEPROD .xlsm
    1 014 KB · Affichages: 25
Vote positif 0 Vote négatif

Discussions similaires

I
  • Question
Microsoft 365 gestion des erreurs vba Excel
Réponses
2
Affichages
211
iliess
I
D
  • Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
352
crocrocro
C
S
  • Question
Microsoft 365 Amélioration d'un code
Réponses
6
Affichages
376
Stéfane
S
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
140
marie3107
M
G
  • Question
XL 2016 Demande de conseils VBA : de la fenêtre unique (XL 2010) au multifenêtres (XL 2016)
Réponses
0
Affichages
395
Guy_M
G
I
  • Question
XL 2019 Envoyer image et mise en forme conditionnelle dans un mail
Réponses
1
Affichages
726
patricktoulon
patricktoulon
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
374
un internaute
U
M
  • Question
XL 2013 VBA-Envoyer par email "Plage de cellules collée dans un nouveau classeur en gardant formules de certaines cellules
Réponses
2
Affichages
677
MONTREAL2020
M
ZAKAO
  • Résolu(e)
XL 2013 Labels dynamiques error (une ligne de code pose problème)
Réponses
4
Affichages
320
ZAKAO
ZAKAO
A
  • Résolu(e)
XL 2019 Passage de 2013 pro à 2019 pro, Pb avec formule VBA, liens hypertexte
2 3 4
Réponses
54
Affichages
2 K
sylvanu
sylvanu

Membres actuellement en ligne

18 membres et 369 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 169
Messages
2 085 926
Membres
103 043
dernier inscrit
nouha nj