Gagner quelques précieuses secondes sur un programme VBA [résolu]

stephsteph · 13 Mars 2012

Bonjour,
Ma démarche est très inhabituelle, je l'admet.
J'ai un VBA (excel 2000) qui marche OK (bien sûr, ce n'est pas moi qui l'est écrit).
A l'origine (2001), sur un PC à 400 Mhz, le programme tournait en 4h30, mais je ne le faisais tourner que une fois par an et le nombre de lignes de base était de l'ordre de 3000.
Aujourd'hui avec mon i5, il met un peu plus de 90 mn même si le nombre de lignes de base a triplé.
Mon problème : je dois le faire tourner maintenant au moins une fois par semaine et cela devient un poids.
Je me demande si quelqu'un de calé pourrait jeter un coup d’œil sur le code pour l'alléger et le "rapidifier" (histoire de gagner quelques secondes ou dixièmes de secondes par ligne traitée).
Si une personne du forum réagit favorablement je mettrai le code (rien de bien sorcier, c'est très mécaniste) dans le prochain message.
Merci d'avance
Steph

pierrejean · 13 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

Re

Tu peux mettre ton fichier (quelques lignes non confidentielles ) ?
Je suis sur que tu auras des reponses

ROGER2327 · 13 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

Re...

Je suis du même avis que pierrejean.

À pierrejean : notre amie a du nez en posant son problème sur ce forum, n'est-ce pas ?

Non, non... Circulez, il n'y a rien à voir...

ROGER2327
#5628

Jeudi 19 Pédale 139 (Sainte Goutte, fête militaire - fête Suprême Quarte)
23 Ventôse An CCXX, 7,3880h - cochléaria
2012-W11-2T17:43:52Z

pierrejean · 14 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

à ROGER

Voulez vous dire que grace au pif elle ne craint pas la panne ?

mutzik · 14 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

Bonjour Steph, Roger, PierreJean

As-tu essayé de mettre en calcul sur ordre avant de lancer cette fameuse macro que nous attendons et de faire les calculs après que la macro ai fini son traitement. En principe, cela aide grandement

Misange · 14 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

Bonjour
LE truc qui fait gagner un temps considérable dans une macro, c'est de faire les traitements de données dans des arrays au lieu de traiter le tableau ligne par ligne.
J'ai eu le même genre de questionnement que toi sur un fichier qui devenait de plus en plus gros au fil des ans au point de devenir inutilisable. J'ai accéléré le traitement d'un facteur au moins 100 en traitant tout dans des arrays. C'est du reste à cette occasion que j'ai écrit les 8 pages de tutos sur les arrays que tu trouves ici
Ce lien n'existe plus
Ca prend un peu de temps pour mettre ça au point mais franchement ça vaut largement le coup.
Et bien sur comme dit mutzik de mettre le calcul en manuel en début de macro et le remettre en auto à la fin. Ca c'est le minimum syndical 🙂

stephsteph · 14 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

Bonjour,
Je ne m'attendais pas à autant, c'est sympa.
Ci-après, le code en 3 parties, la macro principale et 2 sous macros (rien de confidentiel).
Je voudrais préciser (si cela peut aider) que j'ai maintenant Excel 2007.
Le fichier de départ est biblio.xls et le fichier produit est indexweb.xls.
Le fichier de départ (une biblio) comprend 6 colonnes toujours remplies (références par morceau), la 7ème toujours remplie comprend le 1er code clé, ensuite selon chaque ligne il peut y avoir 0 colonne remplie supplémentaire ou jusqu'à 150 colonnes remplies (et cela augmente avec le temps).
Il y a aussi des fichiers intermédiaires et un fichier qui reçoit des erreurs dans le fichier de base.
Merci d'avance, Steph

xxxxxxxxxxxxxxxxxxxxx

Code:

Sub Index()
    Range("A1").Select
    Workbooks.Add
    ChDir "C:\Acad\Index_x"
    ActiveWorkbook.SaveAs Filename:="C:\Acad\Index_x\index_06.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:="C:\Acad\Index_x\index_02.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:="C:\Acad\Index_x\index_er.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    Application.Run "Biblio.xls!ORF11"
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Key2:=ActiveCell. _
        Offset(0, 2).Range("A1"), Order2:=xlAscending, Key3:=ActiveCell.Offset(0, 1). _
        Range("A1"), Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom
    Windows("Biblio.xls").Activate
    Range("A1").Select
    Application.Run "Biblio.xls!ORF12"
    Range("A1").Select
    Windows("index_02.xls").Activate
    ActiveCell.Offset(0, -7).Columns("A:A").EntireColumn.Select
    Selection.Find(What:="Généralités", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False).Activate
    ActiveCell.Select
    Selection.EntireRow.Delete
    Range("A1").Select
    Cells.Replace What:="[", Replacement:="-  ", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False
    Cells.Replace What:="]", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False
    Range("A1").Select
    ActiveCell.Select
    Selection.EntireColumn.Insert
    Selection.EntireColumn.Insert
    ActiveCell.Offset(0, 1).Range("A1").Select
    Workbooks.Open Filename:="C:\Acad\Indic\Listweb.xls"
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("index_02.xls").Activate
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -1).Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "$"
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "si(LC(1)=LC(2);""vrai"";""faux"")"
    ActiveCell.FormulaR1C1 = "=IF(RC[1]=RC[2],""vrai"",""faux"")"
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    ActiveCell.Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "TRUE"
    ChDir "C:\Acad\Indic"
    ActiveWorkbook.SaveAs Filename:="C:\Acad\Indic\indexweb.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Code:

Sub ORF11()
Dim Vlig, Vlig2, Vlig3 As String
Dim Vcol As Integer
Windows("INDEX_er.xls").Activate
Windows("INDEX_06.xls").Activate
Range("A1").Select
Vlig2 = CStr(ActiveCell().Row)
Windows("BIBLIO.XLS").Activate
Vlig = CStr(ActiveCell().Row)
Vcol = IIf(ActiveCell().Column < 7, 7, ActiveCell().Column)
Range("B" & Vlig).Select
While Len(ActiveCell()) > 0
    Vbib0 = Trim(ActiveCell())
    Range("C" & Vlig).Select
    Vx = InStr(1, ActiveCell(), ".")
    Vbib1 = Left(ActiveCell(), Vx - 1)
    Range("D" & Vlig).Select
    Vbib6 = Trim(ActiveCell())
    Vbib6 = IIf(Right(Vbib6, 1) = ".", Left(Vbib6, Len(Vbib6) - 1), Vbib6)
    ActiveCell.Offset(0, Vcol - 4).Range("A1").Select
    While Len(ActiveCell()) > 0
        Vx = InStr(1, ActiveCell(), ":")
        Vy = IIf(InStr(1, ActiveCell(), "~*") = 0, Len(ActiveCell()), InStr(1, ActiveCell(), "~*") - 1)
        Vy1 = IIf(InStr(1, ActiveCell(), "~*") = 0, Len(ActiveCell()), InStr(1, ActiveCell(), "~*"))
        Vvg3 = IIf(InStr(1, ActiveCell(), "~*") = 0, "", Right(ActiveCell(), Len(ActiveCell()) - Vy1))
        Vg3 = Trim(Vg3)
        Vz0 = 0
        Vz0 = InStr(1, Vg3, "~*")
        If Vz0 > 0 Then
            Vg4 = Right(Vg3, Len(Vg3) - Vz0)
            Vg4 = Trim(Vg4)
            Vw = InStr(1, Vg4, ".")
            Vg3 = Left(Vg3, Vz0 - 2)
            Vg3 = Trim(Vg3)
        Else
            Vg4 = ""
            Vw = -1
        End If
        Vv = InStr(1, Vg3, ".")
        Vg = IIf(Vv > 0, Vg3, IIf(Vw > 0, Vg4, ""))
        Vg2 = IIf(Vv = 0, IIf(Vw = -1, Vg3, IIf(Vw = 0, Vg3 + " " + Vg4, Vg4)), IIf(Vw = -1, "", IIf(Vw = 0, Vg4, "")))
        Vx = IIf(InStr(1, ActiveCell(), ":") = 0, IIf(InStr(1, ActiveCell(), ".") = 0, InStr(1, ActiveCell(), " "), InStr(1, ActiveCell(), ".")), InStr(1, ActiveCell(), ":"))
        Vesp = IIf(Vx > 1, Left(ActiveCell(), Vx - 1), "")
        Vesp = Trim(Vesp)
        Vesp = IIf(Len(Vg) > 0, Vesp + " " + Vg, Vesp)
        Vesp = IIf(Len(Vg2) > 0, Vesp + " " + Vg2, Vesp)
        Vbib2 = Left(Right(ActiveCell(), Len(ActiveCell()) - Vx), Vy - Vx)
        If Not IsNull(Vbib2) Then
            Vbib2 = Trim(Vbib2)
        End If
        Range("E" & Vlig).Select
        Vbib3 = Trim(ActiveCell())
        Range("F" & Vlig).Select
        Vbib4 = Trim(ActiveCell())
        Vbib5 = "{" + Vbib3 + Vbib4 + "}"
            Vbib = "[" + Vbib0 + " " + Vbib1 + ". " + Vbib6 + ". " + Vbib5 + " : " + Vbib2 + "]"
        Van = "'" + Vbib1
        If IsNull(Vesp) Or IsNull(Vbib) Or IsNull(Van) Or IsNull(Vlig2) Then
            Windows("INDEX_ER.XLS").Activate
            Range("A" & Vlig3).Select
            ActiveCell() = Vlig
            Range("B" & Vlig3).Select
            ActiveCell() = Vcol
            Vlig3 = CStr(Val(Vlig3) + 1)
        Else
            Windows("INDEX_06.XLS").Activate
            Range("A" & Vlig2).Select
            ActiveCell() = Vesp
            Range("B" & Vlig2).Select
            ActiveCell() = Vbib
            Range("C" & Vlig2).Select
            ActiveCell() = Van
            Vlig2 = CStr(Val(Vlig2) + 1)
        End If
        Windows("BIBLIO.XLS").Activate
        Vcol = CStr(Val(Vcol) + 1)
        ActiveCell.Offset(0, Vcol - 6).Range("A1").Select
    Wend
    Vlig = CStr(Val(Vlig) + 1)
    Vcol = 7
    Range("B" & Vlig).Select
Wend
Windows("INDEX_06.XLS").Activate
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Code:

Sub ORF12()

    Windows("INDEX_06.xls").Activate
    Cells.Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("C1") _
        , Order2:=xlAscending, Key3:=Range("B1"), Order3:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("A1").Select
    Windows("INDEX_02.xls").Activate
    Cells.Select
    Cells.Delete
    Vliga = "1"
    Vlig2a = "1"
    Windows("INDEX_06.xls").Activate
    Range("A" & Vliga).Select
    While Len(ActiveCell()) > 0
        Vesp = Trim(ActiveCell())
        Vcol2 = 0
        While Vesp = Trim(ActiveCell())
            Range("B" & Vliga).Select
            Vbib = Trim(ActiveCell())
            Windows("INDEX_02.xls").Activate
            If Vcol2 = 0 Then
                Range("A" & Vlig2a).Select
                ActiveCell() = Vesp
            End If
            Range("B" & Vlig2a).Select
            ActiveCell.Offset(0, Vcol2).Range("A1").Select
            ActiveCell() = Vbib
            Vcol2 = Vcol2 + 1
            Windows("INDEX_06.xls").Activate
            Vliga = CStr(Val(Vliga) + 1)
            Range("A" & Vliga).Select
        Wend
        Vlig2a = CStr(Val(Vlig2a) + 1)
        Range("A" & Vliga).Select
    Wend
    
End Sub

Misange · 14 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

Tu sais, envisager d'améliorer les lignes de code de quelqu'un d'autre sans avoir le classeur pour tester, sans savoir à quoi sert ce code, (pas un seul commentaire dedans !!) c'est en ce qui me concerne aussi amusant que d'aller dans le placard de quelqu'un d'autre pour essayer d'y mettre de l'ordre 🙁
MAis il y a une chose qui déjà me saute aux yeux c'est le nombre incroyable de SELECT
dans 99.99% des cas il n'est pas besoin de sélectionner une cellule ou une plage pour travailler dessus
travaille déjà sur ça et ton code ira déjà beaucoup mieux.

je ne vois aucune déclaration de variable dans tes macros. Même chose, ce n'est pas une ornementation inutile les déclarations de variable
mais surtout reprend ce que je t'ai dit sur les arrays. Vu le type de traitement migne par ligne que tu fais tu y gagneras un temps considérable (après avoir investi de ton temps avant certes).
bon courage

stephsteph · 15 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

Bonjour Misange,
Je suis désolée mais je n'ai pas écrit ce code.
Si il faut écrire 3 lignes d'exemple pour avoir la réponse, c'est OK, je le ferai.
Mais je crois comprendre en relisant les autres réponse initiales que c'était peut-être des plaisanteries.
Si oui, il vaut mieux dire que ma demande dépasse ce forum et je ferai mes 90 minutes par semaine.
Merci quand même, Steph

Softmama · 15 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

Bonjour à tous,

Même remarque que mes collègues : les Select ne servent à rien du tout dans ton code et c'est ce qui le ralentit considérablement, en l'ayant juste survolé. Pour l'améliorer, il te suffit donc de les supprimer.
Par exemple (un parmi la quantité que tu as), tu peux très bien remplacer :

VB:

        Range("E" & Vlig).Select
        Vbib3 = Trim(ActiveCell())

par l'équivalent, sans faire de sélection :

VB:

        Vbib3 = Trim(Range("E" & Vlig))

Misange · 15 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

stephsteph à dit:
Bonjour Misange,
Je suis désolée mais je n'ai pas écrit ce code.
Si il faut écrire 3 lignes d'exemple pour avoir la réponse, c'est OK, je le ferai.
Mais je crois comprendre en relisant les autres réponse initiales que c'était peut-être des plaisanteries.
Si oui, il vaut mieux dire que ma demande dépasse ce forum et je ferai mes 90 minutes par semaine.
Merci quand même, Steph

J'avoue ne pas avoir saisi les blagounettes de Roger et de Pierre Jean (une private joke ?)
Que veux tu dire par
"Si il faut écrire 3 lignes d'exemple pour avoir la réponse, c'est OK, je le ferai."
ta demande est incompréhensible telle qu'elle est formulée. On n'a pas le classeur (tu peux le joindre si il n'est pas trop lourd), on ne sait pas à quoi il sert, comment il fonctionne. Lire un code comme ça encore une fois c'est assez indigeste.

Après tu dis que tu n'as pas écrit ce code. Ici c'est un forum d'entraide. Si tu veux essayer de comprendre ce code pour l'améliorer tu trouveras de l'aide c'est certain. Si tu veux quelqu'un qui te l'améliore et te le livre sur un plateau tu as peu de chance de le trouver. Le plaisir sur un forum ce n'est pas d'écrire des lignes de codes c'est d'aider le demandeur à progresser.
Si tu te plonges dans le VBA tu verras que c'est assez amusant et qu'on peut vraiment faire des tas de choses...

pierrejean · 15 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

Re
@ Misange
joke semi private (voir MP)

@ Steph

Ayant perdu l'illusion d'ameliorer mes concitoyens et etant un peu plus altruiste que Misange (et ayant surement plus le temps qu'elle ) je suis a ta disposition pour tenter d'accelerer ton code a partir d'un fichier comportant un minimum d'explications et quelques lignes non confidentielles

stephsteph · 16 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

Bonjour,
Et merci beaucoup à tous pour ces 1ères pistes.
J'ai fait tourné la macro avec les petites corrections et j'ai gagné quelques minutes, super.
Je joins 2 fichiers Excel 2000 avec un petit échantillon : biblio.xls, en fait il y a plus de 9000 lignes et les colonnes vont jusqu'à plus de 150)
Et avec le résultat attendu dans indexweb.xls
* en haut, avant la ligne des 'xxxx", les calculs intermédiaires qui commencent par séparer les contenus des colonnes de biblio.xls à partir de la 7ème avec le délimitateur ':' dans les références
* en bas, après la ligne des 'xxxx", le résultat final obtenu après réorganisation des résultats intermédiaires et le classement des références par ordre chronologique croissant (colonne 3 de biblio.xls).
Oui je sais que je demande peut-être beaucoup, mais cela n'est pas de la paresse.
Je fais déjà pas mal les macros automatiques.
Et je m'y met sur des conversions de macros xlm simples et pourtant je rame (oh que je rame!), mais j'en ai réussi 2 sur 15.
Pour la macro difficile, là j'en ai pour jusqu'à la retraite.
Donc à votre bon coeur !
Et merci Pierre-Jean (j'espère que mes explications sont claires)
Steph

pierrejean · 16 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

Re
Vois si cela te convient
Avec mes excuses au cas ou tu aurais été choquée des 'blagounettes' entre l'ami ROGER et moi même
resultat en Feuil2 de indexweb
PS: controle bien avant de lancer sur gros fichier (les tests c'est pas mon fort !!)

Edit: Je m'apercois que je n'ai pas traité l'ordre des dates (colonne 3) : je m'y colle : un peu de patience

pierrejean · 16 Mars 2012

Re : Gagner quelques précieuses secondes sur un programme VBA

Re

Voici la version avec tri des dates

Gagner quelques précieuses secondes sur un programme VBA [résolu]

stephsteph

XLDnaute Occasionnel

pierrejean

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

mutzik

XLDnaute Barbatruc

Misange

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

Misange

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

Softmama

XLDnaute Accro

Misange

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

Pièces jointes

pierrejean

XLDnaute Barbatruc

Pièces jointes

pierrejean

XLDnaute Barbatruc

Pièces jointes

Gagner quelques précieuses secondes sur un programme VBA [résolu]

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

Privacy & Transparency

Privacy & Transparency