Boucle (For - Next) de plus en plus lente.

Question

Bonjour à tous,

Voici mon problème. 
Ma macro rappatrie des données provenant d'un site Internet et j'ai plusieurs miliers de pages à scanner et à importer. (site dont j'ai un accès spéciale pour ce genre d'opération).

Tout fonctionne bien sauf que plus le traitement avance et plus la cadence d'import ralenti.

Pour les 1000 premiers imports ca tourne à environ 230 pages/minutes
les 1000 suivantes ca tombe à 180/minutes
ainsi de suite jusqu'a prendre plus d'une seconde par page.

Y'a t'il quelque chose à faire pour maintenir le rythme en début de traitement?
(vidage de cache ou autre?)
Quelles sont les techiques pour cela?


En gros voici ce que fait la macro:


dim pagedusite as integer

FOR pagedusite = 1 to 5000
monsite = www.monsiteinternet.fr/pagedusite

1) Import des données du site Internet (très leger, environ 20 lignes Excel par page). sur la worksheet temporaire.

2) formatage des données selon mes besoins

3) Ajout du résultat dans une autre worksheet.

4) effaçage des données importées sur la worksheet temporaire

Next


Avez vous une idée pour maintenir le debit de traitement comme il est durant les 1000 premières lignes?

Merci à tous pour votre aide.
Bonne journée.

cs_Jack · Answer

Salut
Donc tu bosses sous Excel (pas précisé)
Catégorie de la question modifiée VB6 --> VBA

Il faudrait jeter un oeil à la quantité de mémoire qu'utilise ton application : "Gestionnaire des tâches", onglet "Processus".
Si l'espace mémoire utilisé pour ton application grandit, c'est normal puisque tu stockes des données sur tes feuilles.
Par contre, il faut voir si cet espace mémoire ne grandit pas trop (la limite est difficile à préciser).

Si tu stockes des données dans une feuille Excel, il serait bon de prévoir un enregistrement (Save) de tes feuilles de temps à autre (toutes les 10 ou 20 interrogations, par exemple), cela peut libérer l'espace mémoire.

De plus, il faudrait voir si l'espace mémoire libre de ta machine ne frôle pas trop avec la quantité mémoire disponible ("Gestionnaire des tâches", onglet "Performances") car, dans ce cas, Windows commence la gestion d'un fichier d'échange en guise de mémoire et les vitesses de traitement peuvent en être altérés (temps d'accès disque).

Sinon, bien sûr, il faut faire attention à bien vider les variables tableau (Erase) ou désactiver les objets temporaires comme les classes (Set maClasse = Nothing) avant de sortir d'une procédure.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

<hr />Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

altarez · Answer

Salut Jack,

Merci de ta réponse. Oui effectivement j'avais oublié de préciser Excel & VB6 (désolé).

J'ai que 3 variables (type : string) qui sont dans la boucle.

J'ai suivi tes conseils concernant la mémoire et il n'y a pas de soucis de ce coté (en utilisation (excel.exe) CPU entre 5 et 20% et memoire entre 34-36Ko)

Ca rame beaucoup en faite avec cette ligne. Ca vient de là je pense.


Worksheets("Temp").Range("c1:c10").Copy

Worksheets("Final").Cells(nRow, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True

OU:
Sheets("Temp") revoit les données du site (format texte sans image ni rien)

Sheets("Final") la ou est colé les cellules dont j'ai besoin (copy/paste et transpose de vertival vers horizontal)

la variable nRow est de type integer et elle s'incrémente d'1 à chaque passage (apres un If cells(1,1) <> "" qui permet de ne pas ajouter les données dans la feuille final si l'import de la page "x" n'a pas de données.)


Les 2 feuilles sont dans le même classeur Excel.
Ca serait cette ligne de code qui ralentirai de plus en plus durant l'exécution de la macro.

En toute franchise je ne vois pas trop comment remplacer cette ligne par quelque chose de plus rapide. (je pensais l'avoir déjà bien minimisé)

Merci pour ton aide et si tu as un petit tips pour faire un copier coller plus rapide je suis bien-sur preneur.

Merci et bonne après midi.

us_30 · Answer

Bonsoir,

En réalité, tu en dis pas assez mais en même temps c'est surement pas évident aussi... Ce que je tiens à signaler c'est que peut-être ce n'est pas Excel qui ralenti en fonction de la quantité, mais la façon dont les données du site en question sont rapatriés... j'imagine qu'un fichier d'échange doit servir de tampon qlq part... (C'est peut-être aussi ce que dis Jack, par ailleurs)... En effet, rien justifie à ma connaissance de passer à 1 seconde par page... Il y a forcément un "goulot de rétrécissement" que la fonctionnement de la macro seul ne peut pas expliquer, à coup sur.

Sinon, on peut encore augmenter les perfs d'Excel en passant par un tableau Array, en ce qui concerne la copie ou autre traitement de calcul... mais je ne sais pas si cela peut s'appliquer et rester pratique dans ton cas.

Amicalement,
Us.

cs_Jack · Answer

Ok pour la mémoire.

Question : Ta feuille Temp est-elle une feuille réelle ou bien une feuille que crées puis supprime à chaque passage ?
Si tu la gardes, comment la nettoies-tu avant rafraichissement ?

Regarde aussi comment arrivers les données dans cette feuille. Peut-être est-ce l'insertion des données dans cette feuille qui rame.

Est-ce que tu peux faire l'essai de faire tourner ton appli en sautant le PasteSpecial avec Transposition ?
Eventuellement, installe un mouchard pour chronométrer (avec l'API "GetTickCount") chaque paquet d'instructions et analyser le paquet qui prend le plus de temps + voir quel paquet ralentit au fur et à mesure de l'avancement.

nRow vaut combien, vers la fin ? Est-ce un très grand nombre ?
Je vois 5000 interrogation, mais une interrogation génère combien de lignes ?
Car là aussi, si ta feuille Final grossit de trop, ça peut ralentir. Voir dans Excel le maximum de ligne d'une feuille.
Il me semble que ça tournait aux alentours de 32767 mais ce chiffre devait être vrai pour la version 97 de Office.

Quelle version de Excel ?
Quel Windows ?
Combien de mémoire installée ?

Tant de paramètres qui peuvent influencer le comportement ...

Calade · Answer

Juste pour ajouter mon grain de sel:

altarez, as-tu essayé de rapatrier d'un coup (cad excel fermé) tes pages internet en les stockant dans un recordset déconnecté, cela risque de te prendre pas mal de mémoire, mais pour combien de temps ? Cela vaudrait peu-être le coup d'essayer. Et tu déverserais le tout dans Excel en une seule fois.

Jack, le nb maxi de lignes sous Excel et de 65536 de la version 2000 à 2003 inclus. Je crois que la version 2007 n'est pas limité (ou beaucoup moins).

En espérant que cela aidera.

Calade

altarez · Answer

Merci à tous pour vos réponses!
Ca me donne pas mal d'idée (bien que je me sens assez limité au niveau connaissances pour tout ce que est rappatriment de données d'Internet.

Pour les infos matérielles :
Excel 2003
2G de RAM, Win Vista 32b, Intel dualcore 2140.

J'ai l'impression que ca ralenti beaucoup au moment de traiter les données importé (l'importation des données sur la feuille "Temp" est super rapide).
La feuille "Temp" est fixe et je supprime les données avant un nouvel import avec Cells.clearContent.

Le mieux c'est de vous montrer le code..
J'imagine qu'il y a 1000 façon de faire ça et par des logiciels bien plus puissant (genre VB) mais malheuresement je ne connais que VBA.


=======================================

Sub ImportPage()

Dim url as string
Dim nRow as integer


On Error Resume Next
 
nRow = 2
Worksheets("Temp").Select
 
For i = 1 To 5000
    url = "https://geco1.amf-france.org/Public/OPCVM_Etranger/OPE_visualisation_caract.asp?Code=" & i
    Application.StatusBar = "Traitement de la page : " & i
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;" & url _
            , Destination:= _
            Range("Temp!a1"))
            .Name = "OPE_visualisation_caract.asp?Code=1"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlAllTables
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With

     Worksheets("Temp").Range("c1:c10").Copy
     Worksheets("Final").Cells(nRow, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

                    nRow = nRow + 1
     Worksheets("Temp").Cells.Clear

Next i
 
Application.StatusBar = False

End Sub


Voila en gros une partie du code. Ca ralenti donc beaucoup à la ligne :
Worksheets("Final").Cells(nRow, 1).PasteSpecial....

Peut-être que les données garde un lien vers le site et que ca rame des que je les copie/colle.. 

Merci encore à tous pour vos lumières.
Bonne journée sous ce super temps!

altarez · Answer

Calade : Ca a l'air d'être une bonne idée (j'ai pas mal de mémoire et ça ne me dérange pas de dédié mon ordinateur à cette tache) mais franchement, J'ai pas les compétences pour faire ça.
Je vois même pas comment rapatrier tout cela sans ouvrir Excel. Je n'ai que des connaissances basic sur VBA.

Calade · Answer

Bonjour,

Je n'ai pas dit qu'il ne fallait pas ouvrir Excel. Il te faut opérer en 2 temps:

1)Sans ouvrir Excel, tu peuples to recordset à partir de tes pages Internet
2) tu libères ta mémoire de tout ce qui concerne Internet, tu ouvres Excel comme tu le faisais auparavant et tu remplis ton onglet en une seule fois.

Calade

Calade · Answer

Pardon j'ai oublié. Un recordset déconnecté est un recordset dont la chaîne de connexion est vide. Tu le définis comme les autres et tu définis les champs un a un dans l'ordre où tu vas les récupérer recordset.fields.Append avec les paramètres suivants (dans l'ordre):

Name This parameter accepts a string that represents the name of the new field.

Type This parameter can take a byte value from DataTypeEnum and designates the data type for the new field.

DefinedSize This parameter accepts long type data and is optional. It is the defined size for the new field.

Attributes This optional parameter accepts long type data. It sets attributes for the new field.

FieldValue This optional parameter accepts a Variant containing the value of the new field.

désolé pour l'anglais mais j'ai fait un copier-coller d'une doc sur ADO. Calade

altarez · Answer

Houla, je me sens bien seul là :-)

Je ne sais pas ce que c'est un recordset et comment l'utiliser.
Concernant le bout de code "querytable.add" je l'ai trouvé mais pas créé.
Je ne connais donc pas vraiment les méthodes associées a ce type de fonction.

Pour le moment tout passe pas Excel à travers VBA.

Je vais être complètement perdu sur un autre type de programmation.

Calade · Answer

Bonjour,

Un recordset est en ensemble d'enregistrements renvoyés par ta base de données suite à une requête. Normalement il faut d'abord se connecter à la base pour l'interroger.

Dans ton cas il faut simplement définir une variable comme étant de type recordset et lui ajouter des champs (ce qui auraient été fait automatiquement dans un cas normal).

1°) Dans ton code VB6 (Menu Projet/Références) ajoute la référence suivante: Microsoft ActiveX Data Objects 2.x Library (en principe x = 7 ou 8, prend la plus élevée).

2°) Dim MyRecordset as ADODB.Recordset
     Set MyRecord = Nex ADODB.Recordset
    MyRecordset.Fields.Append Field, etc... (l'Intellisense te guidera sans problème)

3°) puis une boucle pour récupérer les valeurs de ta/tes pages internet puis peupler ton recordset comme ceci:
   MyRecordset.AddNew
   MyRecordset.Fields("Champ1").Value = ta 1ère valeur
   MyRecordset.Fields("Champ2").Value = ta 2ère valeur
   etc... autant que tu as de champs à récupérer et au dernier
   MyRecordset.update (de tête je ne rappelles plus si le .Update est obligatoire pour un recordset déconnecté, si ça plantes essaye sans).

En espérant que cela t'aidera.
Pour plus de renseignements http://www.developpez.com/ et recherche ce qui à rapport à ADO.
Calade

Calade · Answer

Re Bonjour,

Je crois que j'ai loupé une info. Tu travailles apparemment depuis Excel et non VB6. Si c'est le cas, dans ton code VBA sous le menu Outils/Références ajoute la référence indiqué plus haut.

Bien entendu dans ce cas, Excel sera déjà ouvert et occupera déjà sa propre mémoire.

Pour le reste pas de changement.

Désolé pour ce contretemps, je devrais aller me coucher.

Calade

altarez · Answer

Salut Calade,

Oui effectivement je suis sous Excel et donc VBA.
Merci beaucoup pour toutes tes explications et le temps que tu as passé pour me rédiger les lignes de codes.

Je tente tout ça et je te dis. (je vais également aller faire un tour sur le site que tu m'a donner pour en apprendre un peu plus sur cela car ça a l'air très pratique)

Encore merci.
Excellente soirée

cs_Orohena · Answer

Bonjour

Attention, à chaque passage de ta boucle, tu ajoutes un nouvel élément à la collection QueryTables, sans jamais en supprimer. Cela consomme beaucoup, et ton problème vient peut-être de là.

Utilise la propriété Count et la méthode Delete de la collection QueryTable pour supprimer un élément quand il est devenu inutile, c'est à dire juste avant le Next i.

Amicalement

us_30 · Answer

Bonjour,

100% d'accord avec Orehena. Je suis arrivé à cette conclusion quand j'ai voulu reprendre ton code en l'optimisant. Mais, personnellement n'utilisant peu QueryTable, je ne vois pas comment supprimer la liaision des cellules avec la Table querry en qlq sorte (sauf manuellement)...

Ma version actuellement :

Option Explicit

Sub ImportPage()

'Désactive la mise à jour de l'affichage
Application.ScreenUpdating = False
'Désactive la mise à jour des recalculs
Application.Calculation = xlCalculationManual

' Paramètres
Dim Url As String
Dim i As Integer
Dim Ref As String
Dim RefAncien As String

Dim temps
temps = Timer

' Algo

Url = "https://geco1.amf-france.org/Public/OPCVM_Etranger/OPE_visualisation_caract.asp?Code="
Worksheets("Temp").Select

For i = 1 To 5
    Application.StatusBar = "Traitement de la page : " & Str$(i)
    Ref = "Temp!A" & Trim$(Str$(1 + (i - 1) * 10))
    
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & Url & Str$(i), Destination:=Range(Ref))
        .SaveData = False 'True
        .Name = ""
        .EnableRefresh = False
        .FieldNames = False 'True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False 'True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False 'True
        .RefreshStyle = 0 'xlInsertDeleteCells
        .SavePassword = False

        .AdjustColumnWidth = False 'True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = False 'True
        .WebConsecutiveDelimitersAsOne = False 'True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
Next i

' Supprimer le "lien" QueryTable des cellules : on le fait facilement à la main, mais pas en prog...
'ActiveSheet.QueryTable.Delete

' Recopie des cellules sur Final
RefAncien = 1
For i = 1 To 5
    Application.StatusBar = "Traitement de section : " & Str$(i)
    Ref = Trim$(Str$(i * 10))
    Worksheets("Temp").Range("C" & RefAncien & ":C" & Ref).Copy
    Worksheets("Final").Range("A" & Trim$(Str$(i + 1))).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    RefAncien = Ref + 1
Next i

'Ré-activations
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False

MsgBox Timer - temps

End Sub

Amicalement,
Us.

altarez · Answer

Si avec tout ça je m'en sort pas :-)

J'ai appris pas mal de truc (je commence tout juste avec ce type d'import web)


Je vais soit tenter de supprimer la query de cette façon (trouver sur internet)

Dim Qt As QueryTable
 
Set Qt = ActiveSheet.QueryTables("nomdelaquery")
Names(Qt.Name).Delete
Set Qt = Nothing

US : y'a pas mal de truc sympatique dans ton code. Extra!

Mille merci pour votre aide et le temps passé sur ma demande.
Bonne soirée à tous et bonne continuation.

A bientôt

us_30 · Answer

Bonsoir,

Avec tes indications, j'ai pu me mettre sur la bonne voie pour finir le code, qui après un test complet ne souffre pas de ralentissement :

Voici donc ce code fini :

Option Explicit

Sub ImportPage()

'Désactive la mise à jour de l'affichage
Application.ScreenUpdating = False
'Désactive la mise à jour des recalculs
Application.Calculation = xlCalculationManual

' Paramètres
Dim Url As String
Dim i As Integer
Dim Ref As String
Dim RefAncien As String

Dim temps
temps = Timer

' Algo

Url = "https://geco1.amf-france.org/Public/OPCVM_Etranger/OPE_visualisation_caract.asp?Code="
Worksheets("Temp").Select

For i = 1 To 2000
    Application.StatusBar = "Traitement de la page : " & Str$(i)
    Ref = "Temp!A" & Trim$(Str$(1 + (i - 1) * 10))
    
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & Url & Str$(i), Destination:=Range(Ref))
        .SaveData = False 'True
        .Name = Str$(i)
        .EnableRefresh = False
        .FieldNames = False 'True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False 'True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False 'True
        .RefreshStyle = 0 'xlInsertDeleteCells
        .SavePassword = False
        .AdjustColumnWidth = False 'True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = False 'True
        .WebConsecutiveDelimitersAsOne = False 'True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    
    
Next i

' Supprimer le "lien" QueryTable des cellules
DeleteAllQueryTables

' Recopie des cellules sur Final
RefAncien = 1
For i = 1 To 2000
    Application.StatusBar = "Traitement de section : " & Str$(i)
    Ref = Trim$(Str$(i * 10))
    Worksheets("Temp").Range("C" & RefAncien & ":C" & Ref).Copy
    Worksheets("Final").Range("A" & Trim$(Str$(i + 1))).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    RefAncien = Ref + 1
Next i

'Ré-activations
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = ""

MsgBox Timer - temps

End Sub

Sub DeleteAllQueryTables()
'http://www.developpez.net/forums/d140322/logiciels/microsoft-office/excel/vba-excel/vba-e-querytables-boucle/
Dim QT As Excel.QueryTable
For Each QT In ActiveSheet.QueryTables
    QT.Delete
Next QT
End Sub

=
En espérant avoir donnée une réponse satisfaisante, par rapport à ton problème.

Amicalement,
Us.

Boucle (For - Next) de plus en plus lente.

17 réponses

Votre réponse

Discussions similaires