Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Aide | Shop Recherche
1548 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Problème de mise à jours avec une requête Microsoft Query

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Problème de mise à jours avec une requête Microsoft Query

n°2003412
Player1979
Posté le 21-06-2010 à 16:49:32  profilanswer
 

Bonjour à tous,
 
Je réalise un programme en VBA dans lequel je fais une mise à jours de trois requêtes avec paramêtres:  
            Range("A2" ).Select
            Selection.QueryTable.Refresh BackgroundQuery:=False
            Range("H2" ).Select
            Selection.QueryTable.Refresh BackgroundQuery:=False
            Range("O2" ).Select
            Selection.QueryTable.Refresh BackgroundQuery:=False
 
Les paramètres sont renseignés dans des cellules que la requête va chercher sans problème.
 
Mon véritable problème est le suivant.
Lorsque j'utilise mon programme avec mise à jours de ces 3 requêtes en one shot pas de problème. Cependant, dès que je réalise une boucle (For... Next) sur l'un des paramètres au bout d'une trentaine de fois, ça bug. Les requêtes ne m'extraient plus toutes les données.
Message que j'obtiens:
"Cette requête a fourni plus de données que la feuille ne peut en contenir.
- Pour continuer et afficher autant de données que possible, cliquez sur ok.
- Pour annuler la requête, cliquez sur Annuler. Vous pouvez retourner dans Microsoft Query pour créer une requête qui renvoie moins de données etc. ..."
 
Juste pour vous avertir que grosso modo le nombre maxi de données que je dois extraire est de 2000 à 5000 lignes max.
 
Auriez vous des solutions ou des éléments de réponses à me communiquer pour poursuivre mon programme?  
Merci d'avance.
Cordialement.
 
Lili

mood
Publicité
Posté le 21-06-2010 à 16:49:32  profilanswer
 

n°2003423
olivthill
Posté le 21-06-2010 à 17:09:20  profilanswer
 

C'est difficile à dire sans voir la boucle.
Peut-être qu'il faudrait ajouter un DoEvents à l'intérieur, pour que Access ait le temps de respirer.

n°2003428
Player1979
Posté le 21-06-2010 à 17:18:38  profilanswer
 

Ma boucle est une boucle simple qui me permet juste de modifier mon paramètre (98 Noms). J'utilise une boucle for... Next.
Je n'utilise pas Access mais je crée ma requête dans excel avec Microsoft Query.

n°2003429
Player1979
Posté le 21-06-2010 à 17:18:54  profilanswer
 

Merci en tout cas de ton aide

n°2003433
Player1979
Posté le 21-06-2010 à 17:24:57  profilanswer
 

For l = 1 To WVL_NbrePTF
        If TABL_ListePTF(l, 1) = "x" Then
             
            Workbooks(NAME_FILE).Sheets("MENU" ).Select
            Range("C18" ).Value = TABL_ListePTF(l, 2)
            Range("G17:G18,G20:G22,G24:G26,J29,J31,K29,K31" ).Select
            Selection.ClearContents
            Range("E12" ).Select
            Workbooks(NAME_FILE).Sheets("Data" ).Select
             
            Range("A3:S3" ).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.ClearContents
 
            Range("A2" ).Select
            Selection.QueryTable.Refresh BackgroundQuery:=False
            Range("H2" ).Select
            Selection.QueryTable.Refresh BackgroundQuery:=False
            Range("O2" ).Select
            Selection.QueryTable.Refresh BackgroundQuery:=False
     
            If Range("S3" ).Value = 0 Or Range("S3" ).Value = 1 Then
                    WVL_TypeSous = "SOUSCR"
                    WVL_TypeRach = "RACHAT"
            Else
                    WVL_TypeSous = "APPORT"
                    WVL_TypeRach = "RETRAIT"
            End If
        '========================================
        '   ACHATS, VENTES
        '========================================
            WVL_NbreLignes = Application.CountA(Range("A:A" )) - 2
            WVL_TotalAchat = 0
            WVL_TotalVente = 0
            For i = 1 To WVL_NbreLignes
                If Cells(i + 2, 3).Value = "ACHAT" Then
                    WVL_TotalAchat = WVL_TotalAchat + Cells(i + 2, 4).Value
                ElseIf Cells(i + 2, 3).Value = "VENTE" Then
                    WVL_TotalVente = WVL_TotalVente + Cells(i + 2, 4).Value
                End If
            Next
        '========================================
        '   SOUSCRIPTIONS, RACHATS
        '========================================
    WVL_NbreLignes = Application.CountA(Range("H:H" )) - 2
    If WVL_NbreLignes <= 0 Then
        WVL_NbreLignes = 1
    End If
     
    ReDim TABL_DataSousRach(1 To WVL_NbreLignes, 1 To 3)
     
    For i = 1 To WVL_NbreLignes
        For c = 1 To 3
            TABL_DataSousRach(i, c) = Cells(i + 2, c + 8).Value
        Next
    Next
     
    For j = 1 To WVL_NbreLignes
        If j = 1 Then
            WVL_Compt = 1
            ReDim WVL_Dates(1 To WVL_Compt)
            WVL_Dates(WVL_Compt) = TABL_DataSousRach(j, 1)
        ElseIf j <> 1 And TABL_DataSousRach(j, 1) <> TABL_DataSousRach(j - 1, 1) Then
            WVL_Compt = WVL_Compt + 1
            ReDim Preserve WVL_Dates(1 To WVL_Compt)
            WVL_Dates(WVL_Compt) = TABL_DataSousRach(j, 1)
        End If
    Next
     
    ReDim TABL_Souscriptions(1 To WVL_Compt, 1 To 2)
    ReDim TABL_Rachats(1 To WVL_Compt, 1 To 2)
    WVL_Next = 1
    WVL_Boucle = 1
    Do While WVL_Next <= WVL_Compt
        For i = WVL_Boucle To WVL_NbreLignes
            If TABL_DataSousRach(i, 1) = WVL_Dates(WVL_Next) Then
                If TABL_DataSousRach(i, 2) = WVL_TypeSous Then
                    TABL_Souscriptions(WVL_Next, 2) = TABL_Souscriptions(WVL_Next, 2) + TABL_DataSousRach(i, 3)
                    TABL_Souscriptions(WVL_Next, 1) = WVL_Dates(WVL_Next)
                ElseIf TABL_DataSousRach(i, 2) = WVL_TypeRach Then
                    TABL_Rachats(WVL_Next, 2) = TABL_Rachats(WVL_Next, 2) + TABL_DataSousRach(i, 3)
                    TABL_Rachats(WVL_Next, 1) = WVL_Dates(WVL_Next)
                End If
            Else
                WVL_Next = WVL_Next + 1
                WVL_Boucle = i
                GoTo SUIVANT
            End If
            If WVL_Next = WVL_Compt And i = WVL_NbreLignes Then
                GoTo FIN_BOUCLE
            End If
        Next
SUIVANT:    Loop
     
FIN_BOUCLE:    ReDim TABL_SousRachNET(1 To WVL_Compt, 1 To 2)
    WVL_TotalSousRachNET = 0
    For j = 1 To WVL_Compt
         WVL_Souscription = WVL_Souscription + TABL_Souscriptions(j, 2) '## Total Souscriptions ##
         WVL_Rachat = WVL_Rachat + TABL_Rachats(j, 2) '## Total Rachats ##
         TABL_SousRachNET(j, 1) = WVL_Dates(j)
         TABL_SousRachNET(j, 2) = TABL_Souscriptions(j, 2) + TABL_Rachats(j, 2)
         WVL_TotalSousRachNET = WVL_TotalSousRachNET + Abs(TABL_SousRachNET(j, 2))
    Next
        '----------------------------------------------------------------------------
            WVL_NbreLignes = Application.CountA(Range("O:O" )) - 2
     
            WVL_ValoPTF1 = 0
            WVL_Compt = 0
            For i = 1 To WVL_NbreLignes
                If Cells(i + 2, 17).Value <> "" Then
                    WVL_ValoPTF1 = WVL_ValoPTF1 + Cells(i + 2, 17).Value
                Else
                    WVL_Compt = WVL_Compt + 1
                End If
            Next
     
            WVL_NbreJours = 0
            WVL_TurnOver_Min = 0
            WVL_TurnOver_AMF = 0
            WVL_NbreJours = (WVL_Datefin - WVL_DateDebut) + 1
            WVL_ActifMoyen = WVL_ValoPTF1 / WVL_NbreJours
             
            If WVL_ActifMoyen <> 0 Then
                WVL_TurnOver_Min = (Abs(WorksheetFunction.Min(Abs(WVL_TotalAchat), Abs(WVL_TotalVente)) - WVL_TotalSousRachNET)) / WVL_ActifMoyen
                WVL_TurnOverYear_Min = WVL_TurnOver_Min * (365 / WVL_NbreJours)
                WVL_TurnOver_AMF = (Abs(WVL_TotalAchat) + Abs(WVL_TotalVente) - WVL_TotalSousRachNET) / WVL_ActifMoyen
                WVL_TurnOverYear_AMF = WVL_TurnOver_AMF * (365 / WVL_NbreJours)
            Else
                WVL_TurnOver_Min = (Abs(WorksheetFunction.Min(Abs(WVL_TotalAchat), Abs(WVL_TotalVente)) - WVL_TotalSousRachNET))
                WVL_TurnOverYear_Min = WVL_TurnOver_Min * (365 / WVL_NbreJours)
                WVL_TurnOver_AMF = (Abs(WVL_TotalAchat) + Abs(WVL_TotalVente) - WVL_TotalSousRachNET)
                WVL_TurnOverYear_AMF = WVL_TurnOver_AMF * (365 / WVL_NbreJours)
            End If
             
            '==============================================
            ' Ouvrir Classeur, enregistrer sous + écriture
            '==============================================
            Workbooks(WVL_NameFile).Activate
            If WVL_TempLignes = 12 Then
                Cells(10, 4).Value = WVL_DateDebut & " au " & WVL_Datefin
            End If
            Cells(WVL_TempLignes, 2).Value = TABL_ListePTF(l, 2)
            Cells(WVL_TempLignes, 3).Value = TABL_ListePTF(l, 3)
            Cells(WVL_TempLignes, 4).Value = WVL_TurnOverYear_AMF 'Format(WVL_TurnOverYear_AMF, "0.00%" )
            Cells(WVL_TempLignes, 5).Value = WVL_TurnOverYear_Min 'Format(WVL_TurnOverYear_Min, "0.00%" )
             
            WVL_TempLignes = WVL_TempLignes + 1
             
            '==============================================
             
            Workbooks(NAME_FILE).Sheets("MENU" ).Activate
            Range("G17" ).Value = Abs(WVL_TotalAchat)
            Range("G18" ).Value = Abs(WVL_TotalVente)
     
            Range("G20" ).Value = Abs(WVL_Souscription)
            Range("G21" ).Value = Abs(WVL_Rachat)
            Range("G22" ).Value = WVL_Souscription + WVL_Rachat
     
            Range("G24" ).Value = WVL_ValoPTF1
            Range("G26" ).Value = WVL_ActifMoyen
     
            Range("J29" ).Value = Format(WVL_TurnOver_Min, "0.00%" )
            Range("J31" ).Value = Format(WVL_TurnOverYear_Min, "0.00%" )
             
            Range("K29" ).Value = Format(WVL_TurnOver_AMF, "0.00%" )
            Range("K31" ).Value = Format(WVL_TurnOverYear_AMF, "0.00%" )
     
            Workbooks(NAME_FILE).Sheets("MENU" ).Select
            Range("C18" ).Select
        End If
    Next

n°2003452
olivthill
Posté le 21-06-2010 à 17:52:47  profilanswer
 

Oh tous les Redim. Je ne suis pas certain que VB les gèrent correctement. Il serait plus simple et plus sur de dimensionner au début les tableaux avec la taille maximale qu'ils peuvent avoir.
Mais le problème est peut-être ailleurs.
 
Oh les goto, et en plus il y a un goto qui sort d'une boucle pour le premier, et qui sort même de deux boucles pour le second.
Pour le GoTo SUIVANT, il suffit de le remplacer par un Exit For.
Pour le GoTo FIN_BOUCLE, on peut le remplacer aussi par WVL_Next = WVL_Next + 1 et Exit For, comme ça il sortira du For, et il ne rentrera pas dans Do While car la condition de fin sera vérifiée.
Mais le problème est peut-être ailleurs.
 
En tous, cas je conseille d'ajouter un DoEvents juste avant le dernier Next. Cela ne peut pas faire de mal.

n°2003455
Player1979
Posté le 21-06-2010 à 17:58:00  profilanswer
 

Ok merci pour ces précieux conseils. J'apprends le vba un peu au fur et à mesure...
Je vais apporter des modifs dans mon code et te tiens au courant.
Merci.

n°2003456
Player1979
Posté le 21-06-2010 à 17:59:02  profilanswer
 

Par contre pour les REDIM, je ne pense pas pouvoir faire autrement car je ne connais pas à l'avance les dimensions des tableaux.

n°2003488
Player1979
Posté le 21-06-2010 à 19:24:22  profilanswer
 

Je pense que c'est un problème de mémoire ou de capacité.
Peut-on purger la mémoire ? Méthode Flush  en VBA ?
Merci

n°2003523
Player1979
Posté le 21-06-2010 à 21:32:23  profilanswer
 

Personne ne voit de solution à mon problème.
J'ai l'impression qu'à partir d'un moment à force d'actualiser mes requêtes le système devient instable.

mood
Publicité
Posté le 21-06-2010 à 21:32:23  profilanswer
 

n°2003644
Player1979
Posté le 22-06-2010 à 11:03:56  profilanswer
 

Je rencontre toujours le même problème à partir d'un moment, ma requête m'extrait que les 2 première lignes. Du moins, je visualise uniquement dans la feuille (état de sortie) que 2 lignes

n°2003732
Player1979
Posté le 22-06-2010 à 14:52:52  profilanswer
 

J'ai l'impression qu'à chaque tour de ma boucle pour changer le parametre, il doit stocker l'extraction des données de la requête qq part. Et au bout d'un certain nombre de tour, il n'a plus de place pour les stocker.
D'où ce msg: "Cette requête a fourni plus de données que la feuille ne peut en contenir.  
- Pour continuer et afficher autant de données que possible, cliquez sur ok.  
- Pour annuler la requête, cliquez sur Annuler. Vous pouvez retourner dans Microsoft Query pour créer une requête qui renvoie moins de données etc. ..."  
 
Quelqu'un aurait il une solution ? Je n'arrive pas à résoudre mon problème.
 
Merci d'avance et bon après midi.

n°2004294
Player1979
Posté le 23-06-2010 à 22:28:20  profilanswer
 

Bon la solution était dans les options de la plage de données de la requête ...


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Problème de mise à jours avec une requête Microsoft Query

 

Sujets relatifs
Problème de syntaxe. Mettre 2 classes pour une pageProbleme avec requete sql NOT EXISTS et NOT IN
problème de zero binaire dans un enregistrementProblème d'authentification en JAVA/J2EE
Problème avec un menu CSSproblème de calcul d'une moyenne en 'double'
petit problème de div à résoudrePYTHON PHP BDD : Gros problème d'encodage
Plus de sujets relatifs à : Problème de mise à jours avec une requête Microsoft Query


Copyright © 1997-2018 Hardware.fr SARL (Signaler un contenu illicite) / Groupe LDLC / Shop HFR