Autres accelerer les fonction

samia89

XLDnaute Nouveau
bonjour tt le monde j'ai besoin de votre svp y a t'il un moyen d’accelerer ces fonctions car elle sont très lentes

VB:
=INDEX(Mouvement!$F$1:$F$9959;MIN(SI((Mouvement!$B$7:$B$1000="sortie")*(Mouvement!$C$7:$C$1000=$A$1)*(NB.SI(A$4:A4;Mouvement!$F$7:$F$1000)=0);LIGNE(Mouvement!$F$7:$F$1000))))&""
Code:
=SI($A5="";"";SOMMEPROD((Mouvement!$F$7:$F$1000=$A5)*(Mouvement!$C$7:$C$1000=$A$1)*(Mouvement!$G$7:$G$1000)*(Mouvement!$B$7:$B$1000="sortie")))
voila l'image du tableau sur le quel je travail e je vous joint mon classeur pour bien voir le problème de lenteur au moment d'exécution des fonctions j’espère vous lire bien tôt
image002.jpg
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
Bonsoir.
Cette solution devrait éliminer le problème :
1) — Laissez s'installer le complément GigIdx.xlam dont je joins le classeur GigIdx.xlsm précurseur.
2) — Dans les références du projet VBA de votre classeur "fonctions.xlsm", cochez "GigIdx". Édition: *
3) — Collez ce code dans le module Feuil12 (Consommation pa Jour)
VB:
Option Explicit
Private Sub Worksheet_Activate()
   ConsoParJour
   End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address = "$A$1" Then ConsoParJour
   End Sub
4) — Dans un module standard que j'ai nommé chez moi MConsoPJour :
VB:
Option Explicit
Sub ConsoParJour()
   Dim LaDate As Date, Données As Collection, SG As SsGr, Trés(1 To 1500, 1 To 4), L As Long
   Set Données = Gigogne(Feuil10.[B7:H7], 2, 1, 5)
   LaDate = Feuil12.[A1].Value
   For Each SG In Données
      If SG.Id = LaDate Then Exit For
      Next SG
   If SG Is Nothing Then MsgBox "Aucune sortie du " & LaDate & " trouvée.", _
      vbCritical, "ConsoParJour": Exit Sub
   Set SG = SG.ItemSsGr("sortie")
   If SG Is Nothing Then MsgBox "Aucune sortie du " & LaDate & " trouvée.", _
      vbCritical, "ConsoParJour": Exit Sub
   Set Données = SG.Co
   For Each SG In Données
      L = L + 1
      Trés(L, 1) = SG.Id
      Trés(L, 2) = SG.Somme(6)
      Trés(L, 3) = SG.Co(1)(7)
      Trés(L, 4) = Trés(L, 2) * Trés(L, 3)
      Next SG
   Feuil12.[A5].Resize(1500, 4).Value = Trés
   End Sub
Édition: * Attention, beaucoup tardent à faire toutes les étapes dans la foulée et dans la même session Excel. Résultat: le projet GigIdx n'est plus ouvert et ne figure donc plus parmi les références disponibles. Si ça devait également vous arriver, coté Excel cette fois: menu Développeur, groupe Compléments, commande Compléments Excel puis cocher "Fonction Gigogne".
 

Fichiers joints

Dernière édition:

samia89

XLDnaute Nouveau
Bonsoir.
Cette solution devrait éliminer le problème :
1) — Laissez s'installer le complément GigIdx.xlam dont je joins le classeur GigIdx.xlsm précurseur.
2) — Dans les références du projet VBA de votre classeur "fonctions.xlsm", cochez "GigIdx". Édition: *
3) — Collez ce code dans le module Feuil12 (Consommation pa Jour)
VB:
Option Explicit
Private Sub Worksheet_Activate()
   ConsoParJour
   End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address = "$A$1" Then ConsoParJour
   End Sub
4) — Dans un module standard que j'ai nommé chez moi MConsoPJour :
VB:
Option Explicit
Sub ConsoParJour()
   Dim LaDate As Date, Données As Collection, SG As SsGr, Trés(1 To 1500, 1 To 4), L As Long
   Set Données = Gigogne(Feuil10.[B7:H7], 2, 1, 5)
   LaDate = Feuil12.[A1].Value
   For Each SG In Données
      If SG.Id = LaDate Then Exit For
      Next SG
   If SG Is Nothing Then MsgBox "Aucune sortie du " & LaDate & " trouvée.", _
      vbCritical, "ConsoParJour": Exit Sub
   Set SG = SG.ItemSsGr("sortie")
   If SG Is Nothing Then MsgBox "Aucune sortie du " & LaDate & " trouvée.", _
      vbCritical, "ConsoParJour": Exit Sub
   Set Données = SG.Co
   For Each SG In Données
      L = L + 1
      Trés(L, 1) = SG.Id
      Trés(L, 2) = SG.Somme(6)
      Trés(L, 3) = SG.Co(1)(7)
      Trés(L, 4) = Trés(L, 2) * Trés(L, 3)
      Next SG
   Feuil12.[A5].Resize(1500, 4).Value = Trés
   End Sub
Édition: * Attention, beaucoup tardent à faire toutes les étapes dans la foulée et dans la même session Excel. Résultat: le projet GigIdx n'est plus ouvert et ne figure donc plus parmi les références disponibles. Si ça devait également vous arriver, coté Excel cette fois: menu Développeur, groupe Compléments, commande Compléments Excel puis cocher "Fonction Gigogne".
bonjour [I]Dranreb[/I] un grand merci pour toi sincèrement maintenant la recherche il se fait rapidement.

j'ai une autre question pour toi si ça te dérange pas; puisque la l’enture des formules et résolut
jusque la les résultats de la recherche s'affichent correctement dans le tableau de mon classeur en ajoutent une date dans la cellule 'A1' et bien sur on a préciser dans le code d'affiche uniquement les 'sortie' selon la date insérer dans 'A1'.

ma question et ce que en peut associer un autre critère de recherche a 'A1'date' on ajoutent la cellule 'E1' pour inséré par ex des nom client' et le résultat finale doit être de cette façon:
pour la cellule 'A1' date' elle fonction très bien elle affiche tout le détail des sorties selon la date inséré dans 'A1'

mais quand j'ajoute un nom 'qui se trouve dans ma base de donné' dans la cellule ' E1' le résultat doit afficher uniquement ' le détail des sortie pour le nom 'E1' selon la date inséré dans 'A1'

image002.jpg
je vous joint mon classeur j'ai applique le code que tu ma donné et merci encor une fois
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
Bonjour.
Module Feuil12 :
VB:
Option Explicit
Private Sub Worksheet_Activate()
   ConsoParJour
   End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Me.[A1,E1], Target) Is Nothing Then ConsoParJour
   End Sub
Module Module1:
VB:
Option Explicit
Sub ConsoParJour()
   Dim LaDate As Date, Client As String, Données As Collection, SG As SsGr, Trés(1 To 1500, 1 To 4), L As Long
   Client = Feuil12.[E1].Value
   If Client <> "" Then
      Set Données = Gigogne(Feuil10.[B7:H7], 3, 2, 1, 5)
      On Error Resume Next: Set SG = Données.Item(Client): On Error GoTo 0
      If SG Is Nothing Then MsgBox "Aucune sortie pour """ & Client & """ trouvée.", _
         vbCritical, "ConsoParJour": Exit Sub
      Set Données = SG.Co
   Else
      Set Données = Gigogne(Feuil10.[B7:H7], 2, 1, 5)
      End If
   LaDate = Feuil12.[A1].Value
   For Each SG In Données
      If SG.ID = LaDate Then Exit For
      Next SG
   If SG Is Nothing Then MsgBox "Aucune sortie du " & LaDate & " trouvée.", _
      vbCritical, "ConsoParJour": Exit Sub
   Set SG = SG.ItemSsGr("sortie")
   If SG Is Nothing Then MsgBox "Aucune sortie du " & LaDate & " trouvée.", _
      vbCritical, "ConsoParJour": Exit Sub
   Set Données = SG.Co
   For Each SG In Données
      L = L + 1
      Trés(L, 1) = SG.ID
      Trés(L, 2) = SG.Somme(6)
      Trés(L, 3) = SG.Co(1)(7)
      Trés(L, 4) = Trés(L, 2) * Trés(L, 3)
      Next SG
   Feuil12.[A5].Resize(1500, 4).Value = Trés
   End Sub
 

Dranreb

XLDnaute Barbatruc
Remarque: Si la table des mouvement était mise à jour au moyen d'un UserForm, il y aurait une autre solution pour extraire ça, et même l'afficher d'abord dans une ListBox.
 

Dranreb

XLDnaute Barbatruc
Peut-on mettre les mouvements sous forme de tableau Excel à références structurées ?
Je joins un autre précurseur de complément qui sera utilisé.
 

Fichiers joints

samia89

XLDnaute Nouveau
Bonjour.
Module Feuil12 :
VB:
Option Explicit
Private Sub Worksheet_Activate()
   ConsoParJour
   End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Me.[A1,E1], Target) Is Nothing Then ConsoParJour
   End Sub
Module Module1:
VB:
Option Explicit
Sub ConsoParJour()
   Dim LaDate As Date, Client As String, Données As Collection, SG As SsGr, Trés(1 To 1500, 1 To 4), L As Long
   Client = Feuil12.[E1].Value
   If Client <> "" Then
      Set Données = Gigogne(Feuil10.[B7:H7], 3, 2, 1, 5)
      On Error Resume Next: Set SG = Données.Item(Client): On Error GoTo 0
      If SG Is Nothing Then MsgBox "Aucune sortie pour """ & Client & """ trouvée.", _
         vbCritical, "ConsoParJour": Exit Sub
      Set Données = SG.Co
   Else
      Set Données = Gigogne(Feuil10.[B7:H7], 2, 1, 5)
      End If
   LaDate = Feuil12.[A1].Value
   For Each SG In Données
      If SG.ID = LaDate Then Exit For
      Next SG
   If SG Is Nothing Then MsgBox "Aucune sortie du " & LaDate & " trouvée.", _
      vbCritical, "ConsoParJour": Exit Sub
   Set SG = SG.ItemSsGr("sortie")
   If SG Is Nothing Then MsgBox "Aucune sortie du " & LaDate & " trouvée.", _
      vbCritical, "ConsoParJour": Exit Sub
   Set Données = SG.Co
   For Each SG In Données
      L = L + 1
      Trés(L, 1) = SG.ID
      Trés(L, 2) = SG.Somme(6)
      Trés(L, 3) = SG.Co(1)(7)
      Trés(L, 4) = Trés(L, 2) * Trés(L, 3)
      Next SG
   Feuil12.[A5].Resize(1500, 4).Value = Trés
   End Sub
merci mille fois ça marche très bien
 

Dranreb

XLDnaute Barbatruc
C'est la première fois que je vois ça. Normalement le message affiche aussi en dessous l'Err.Description. Quelle est elle ?
Si vous tentiez de l'enregistrer manuellement sur votre dossier de complément (donné par Application.UserLibraryPath) comme fichier de type "Complément Excel (*.xlam)" que se passerait-il ?
 

samia89

XLDnaute Nouveau
C'est la première fois que je vois ça. Normalement le message affiche aussi en dessous l'Err.Description. Quelle est elle ?
Si vous tentiez de l'enregistrer manuellement sur votre dossier de complément (donné par Application.UserLibraryPath) comme fichier de type "Complément Excel (*.xlam)" que se passerait-il ?
Instalation abondonnée recommandation ne prenez pas le projet CLsCAs de ce classeur précurseur comme référence dans un autre projet
 

Dranreb

XLDnaute Barbatruc
Il faut d'abord régler le problème de l'installation du CBxLCtlA. Ça m'inquiète cette histoire là.
Non, ça c'est après, mais avant quand il fait :
Err.Clear: Me.SaveAs ChNomF, FileFormat:=xlOpenXMLAddIn
If Err Then MsgBox "Impossible d'enregistrer le complément." _
& vbLf & "Erreur " & Err & " :" & vbLf & Err.Description, _
vbCritical, Titre: Exit Function
qu'est-ce qu'il met comme Err.Description ?
C'est d'autant plus bizarre que l'installation du GigIdx avait bien marché, or il procède exactement de la même façon !

Je joins le générateur d'UserForm permettant de créer celui que j'ai montré.
 

Fichiers joints

samia89

XLDnaute Nouveau
Il faut d'abord régler le problème de l'installation du CBxLCtlA. Ça m'inquiète cette histoire là.
Non, ça c'est après, mais avant quand il fait :qu'est-ce qu'il met comme Err.Description ?
C'est d'autant plus bizarre que l'installation du GigIdx avait bien marché, or il procède exactement de la même façon !

Je joins le générateur d'UserForm permettant de créer celui que j'ai montré.
y a erreur a l'ouverture du classeur GénérateurUFm excel a rencontre un contenu illisible dans GénérateurUFm......
bon si pas méchant je vais travailler directe avec la premier solution VBA que tu ma proposer tout a l'heur elle fonctionne très bien et merci pour tout
 

Dranreb

XLDnaute Barbatruc
Je joins quand même le classeur équipé de l'UserForm, à tout hasard.
Réessayez quand même l'installation du CBxLCtlA, on ne sait jamais c'était peut être un incident isolé.
 
Dernière édition:

samia89

XLDnaute Nouveau
Instalation abondonnée recommandation ne prenez pas le projet CLsCAs de ce classeur précurseur comme référence dans un autre projet
Je joins quand même le classeur équipé de l'UserForm, à tout hasard.
Réessa
désolé pour le derangement
voila le message d'erreur a l'ouverture de CBxLCtlA il est impossible d'enregistrer le compliment erreur 1004
la méthode 'SaveAs' de l'objet'_workbook' a échoué
 
Haut Bas