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

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Code VBA trop lent

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Code VBA trop lent

n°2271199
idva5492
Posté le 09-12-2015 à 12:11:19  profilanswer
 

:) Je récupère le contenu de plusieurs cellules identiques dans plusieurs fichiers d'un même répertoire (ex : A1, B45, C12 pour chaque fichiers) et je les visualise dans un tableau récapitulatif (pour chaque ligne une colonne correspondant aux cellules récupérées, dans mon cas, A1, B45, C12 dans A1, B1, C1)
J'ai écrit le code suivant qui fonctionne très bien, mais pour 100 fichiers qui écrit 100 lignes de résultat, il me faut 2mn minimum
 
Voici une partie de mon code :
 
Sub LancementGeneral()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
 
    Set objShell = CreateObject("Shell.Application" )
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1& )
 
If objFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
   
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
    [X1] = Chemin
    fichier = Dir(Chemin & "*.xlsm" )
    Do While Len(fichier) > 0
     Application.ScreenUpdating = False
    If fichier <> ThisWorkbook.Name Then
            ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$D$5"
            With Sheets("Feuil1" )
                .[X3] = "=Plage"
                .[X3].Copy
                Sheets("Feuil1" ).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                'CREATION FICHE
                 End With
        End If
        If fichier <> ThisWorkbook.Name Then
            ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$D$7"
            With Sheets("Feuil1" )
                .[X3] = "=Plage"
                .[X3].Copy
                Sheets("Feuil1" ).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                'MODIFICATION FICHE
                 End With
        End If
         
        'etc... pour les autres cellules à récupérer
         
       SUITE DU CODE JUSQU'A LA COMMANDE LOOP      
         
        fichier = Dir()
    Loop
End If
Range("C2:I100" ).Sort Key1:=Range("C2" ), Order1:=xlAscending, Key2:=Range( _
        "D2" ), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
        :=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
         
For Each C In Worksheets("Feuil1" ).Range("C2", "D200" )
C.Value = UCase(C.Value)
Next
For Each C In Worksheets("Feuil1" ).Range("F2", "G200" )
C.Value = UCase(C.Value)
Next
Application.ScreenUpdating = True
        End Sub
 
Si quelqu'un a une idée géniale de modification de mon code pour une vitesse de traitement rapide, je suis preneur
 
Merci d'avance
Cordialement  
 
 
 

mood
Publicité
Posté le 09-12-2015 à 12:11:19  profilanswer
 

n°2271207
Chelmi18
Posté le 09-12-2015 à 13:25:25  profilanswer
 

Pour accélérer ton code, il faudrait déjà savoir ce qui le ralentit.
 
As-tu fait un chronométrage fonction par fonction pour voir ?
Insère dans ton code des lignes Debug.Print étiquette_X str(Now) où Etiquette_X est un repère pour savoir où est prise la mesure.
 
Tu auras ainsi un listing des fonctions horodatées dans la fenêtre d'exécution (menu Affichage / Fenêtre d'exécution).
 
Cela va encore ralentir le code mais tu sauras combien de temps tu passes entre chaque instruction et tu sauras donc quelle fonction est consommatrice.
 
D'instinct je dirais la création des plages nommées mais on ne sait jamais...

n°2271972
dje69r
Arme de distraction massive
Posté le 19-12-2015 à 18:18:44  profilanswer
 

100 fichiers... 2mn...
Sélectionne tes 100 fichiers, clic droit, ouvrir, Excel devrait à peu près mettre le même temps... Ensuite appose une modif sur chaque et lance un enregistrement des fichiers en cascades, accès au disque par Excel et suppression des fichiers temp/sauv... Tu verras que 2mn c'est pas si long...
 
Enfin pour faire des traitements de stats et cie sur beaucoup de fichiers Excel, je ne trouve pas ça déconnant...
 
Après si tu es un serveurs avec whatmille threads, des ssd, 32Go de ram, oui c'est lent, sur un poste de bureautique je ne trouve pas ça déconnant...
 
Et sortir le application.screenupdating = false de ton do while non ?


---------------
Plus tu pédales moins vite, moins tu avances plus vite — SuperLoustic ! La radio des Loustics !
n°2271973
dje69r
Arme de distraction massive
Posté le 19-12-2015 à 18:29:03  profilanswer
 

Et tes derniers for each
Tu peux optimiser ça avec un seul
Je suis sur le tel, mais ça devrait le faire :

Code :
  1. For Each C In Worksheets("Feuil1" ).Range("C2:D200","F2:G200" )
  2. C.Value = UCase(C.Value)
  3. Next
 


Et pourquoi tester deux fois

Code :
  1. If fichier <> ThisWorkbook.Name Then

en étant dans la même boucle ?


Message édité par dje69r le 19-12-2015 à 18:33:42

---------------
Plus tu pédales moins vite, moins tu avances plus vite — SuperLoustic ! La radio des Loustics !
n°2271990
kiki29
Posté le 20-12-2015 à 04:36:21  profilanswer
 

Salut, j'ai retrouvé ça : http://forum.hardware.fr/hfr/Progr [...] 0232_1.htm sous l'intitulé : Remise à jour du 09 Août 2007


Message édité par kiki29 le 20-12-2015 à 08:19:57

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

  Code VBA trop lent

 

Sujets relatifs
Souci de conversion de code 2007 vers 2013Conversion algorithme Python -> VBA (combinaisons de p élém. parmi n)
Excel : Code macro pour aller chercher les données d'un autre fichier[Résolu] Rechercher une valeur dans une page
reprogrammer des boutons en VBA[ASP] Terniner une page avec un code retour précis
Code complexe c++Code vba pour le calcul de rendement
Piloter un site Web à partir de VBA[PERL] CGI retourner un code erreur
Plus de sujets relatifs à : Code VBA trop lent


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