Optimiser macro enregistrée

Le 31/07/2019 à 11:14

Hello

Je commence à me former aux macros mais ca reste très compliqué pour moi et suis obligé de passer par les macros enregistrées

C'est très pratique mais du tout optimisé

Voici une macro enregistrée que je souhaite optimiser.

Sur le fichier joint je donne très peu de lignes. En vrai il y a des milliers de lignes et beaucoup de colonnes si bien que la mcro met environ 10sec a tourner

Voici la macro enregistrée et j'ai ajouté du texte pour expliquer ce que je veux

Je n'ai pas mis de bouton pour la lancer, juste un raccourci clavier, ca me va amplement.

Sub projet_oops()
'
' projet_oops Macro
' ajoute une colonne OOPS aux magasins en question
'
' Touche de raccourci du clavier: Ctrl+Shift+O
'
'convertir en nombre la colonne A
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
' insérer une colonne B
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'renommer le titre en OOPS?
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "OOPS?"
'effectuer une recherche V dans la feuille 2 et l'appliquer à toute la colonne
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Feuil2!R1C1:R20C2,2,0)"
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:B30284")
    Range("B2:B30284").Select
'afficher un message comme quoi la macro a bien fonctionné
    MsgBox "Magasins Oops identifiés"
End Sub

Y a t-il moyen de la faire aller plus vite en la faisant à la main? La macro enregistrée ne nomme pas les variables par exemple.

Le plus gros souci est que j'ai étendu ma recherche V jusque la ligne 30284 mais parfois j'aurai plus ou parfois moins en fonction des jours

SI j'ai moins ca va me faire des lignes #N/A inutiles mais surtout si j'en ai plus ma recherche V n'ira pas au bout.

Je pourrai mettre 50000 pour être tranquille mais quitte à optimiser, comment faire en sorte que la recherche V aille jusqu'à la dernière ligne?

6base-oops.xlsm (18.95 Ko)
Le 31/07/2019 à 11:32

Bonjour,

il faut savoir que les "select" ralentissent beaucoup l’exécution.

Range("B1").Select
ActiveCell.FormulaR1C1 = "OOPS?"

Il est plus intéressant de faire de cette manière par exemple

Range("B1").FormulaR1C1 = "OOPS?"

De plus je t'invite à consulter la fonction screenUpdating , il y a de bonne chance que cela améliore la rapidité de ton code.

Le 31/07/2019 à 11:57

Merci

J'ai enlevé les select. mais perso je n'ai pas vu d'amélioration notable sur le délai.

Le plus long est la recherche V appliqué à toutes mes lignes.

Mais le temps est peut-être normal vu le nb de lignes à traiter.

Le 31/07/2019 à 12:00

re,

et screenUpdating ?

Je n'utilise pas de formule (je ne sais pas plutôt ). je ne peux donc pas t'aider, peut être que quelqu'un sait si utiliser un tableau serait plus rapide ?

Cordialement.

Le 31/07/2019 à 12:22

bonjour,

essaie ceci

Sub projet_oops()
'
' projet_oops Macro
' ajoute une colonne OOPS aux magasins en question
'
' Touche de raccourci du clavier: Ctrl+Shift+O
'
'convertir en nombre la colonne A
    Application.Calculation = xlCalculationManual
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                                 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                 Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
                                                                                             :=Array(1, 1), TrailingMinusNumbers:=True
    ' insérer une colonne B
    Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    'renommer le titre en OOPS?
    Range("B1").FormulaR1C1 = "OOPS?"
    'effectuer une recherche V dans la feuille 2 et l'appliquer à toute la colonne
    Range("B2").FormulaR1C1 = "=VLOOKUP(RC[-1],Feuil2!R1C1:R20C2,2,0)"
    Range("B2").AutoFill Destination:=Range("B2:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    'afficher un message comme quoi la macro a bien fonctionné
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Magasins Oops identifiés"
End Sub
Le 31/07/2019 à 12:27

Bonjour tout le monde !

Autre proposition :

Sub projet_oops()

Dim DerLig As Long, Lig As Long 'Déclaration des variables

Application.Calculation = xlCalculationManual 'Désactive le recalcul auto de toutes le formules, le temps de la macro

With Sheets("MaFeuille") 'Nom feuille à adapter
    DerLig = .Range("A" & Rows.Count).End(xlUp).Row 'Détermine la dernière ligne
    .Columns("A:A").TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote 'convertir en nombre la colonne A
    .Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'insérer une colonne B
    .Range("B1") = "OOPS?" 'renommer le titre en OOPS?
    For Lig = 2 To DerLig 'Parcourir les lignes
        .Range("B" & Lig) = Application.VLookup(.Range("A" & Lig), Sheets("Feuil2").Range("A1:B20"), 2, 0) 'Inscrit le résultat de la recherche "en dur" (pas de formule dans la cellule)
    Next Lig
    MsgBox "Magasins Oops identifiés" 'afficher un message comme quoi la macro a bien fonctionné
End With

Application.Calculation = xlCalculationAutomatic 'Ré-active le recalcul auto de toutes le formules, le temps de la macro

End Sub
Le 31/07/2019 à 14:01

merci!

h2so4 j'ai un débogage sur cette ligne (erreur1004)

 Range("B2").AutoFill Destination:=Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)

Je n'ai pas réussit à trouver l'erreur

Par contre celle de Pedro marche à merveille.

En terme de temps, c'est un peu plus rapide. Mais surtout ma recherche V s'applique bien en fonction de mon nombre de ligne.

C'est bien d'avoir mis en dur le résultat en plus

C'est parfait en comparant la macro enregistrée et la manuelle, ca me permet de comprendre les subtilités

Merci à vous!

Le 31/07/2019 à 14:08
evolm a écrit :

merci!

h2so4 j'ai un débogage sur cette ligne (erreur1004)

 Range("B2").AutoFill Destination:=Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)

Je pense que c'est une erreur d'inattention... A ce stade, la colonne 2 est incomplète, on ne peut donc pas l'utiliser pour déterminer la dernière ligne.

Il suffit de remplacer le dernier "2" par "1" (pour se baser sur la colonne 1) :

 Range("B2").AutoFill Destination:=Range("B2:B" & Cells(Rows.Count, 1).End(xlUp).Row)

Merci de ton retour concernant ma proposition. Je peux aussi te proposer une version avec variable tableau et sans RECHERCHEV.

Le 31/07/2019 à 14:11

bonjour,

merci!

h2so4 j'ai un débogage sur cette ligne (erreur1004)

Range("B2").AutoFill Destination:=Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)

Je n'ai pas réussit à trouver l'erreur

je suppose qu'il fallait que je me base sur la colonne A et non la colonne B pour déterminer le nombre de lignes

 Range("B2").AutoFill Destination:=Range("B2:B" & Cells(Rows.Count, 1).End(xlUp).Row)
Le 31/07/2019 à 14:13
Pedro22 a écrit :

Merci de ton retour concernant ma proposition. Je peux aussi te proposer une version avec variable tableau et sans RECHERCHEV.

Ne t'embete pas.

Ca marche impeccable ainsi. La macro prend 5 secs et elle ne sera lancée qu'une fois chaque matin.

Le 31/07/2019 à 14:20

Pour la forme (je n'ai pas testé le code) :

Option Base 1
Sub projet_oops()

Dim DerLig As Long, Lig As Long, DerLig2 As Long, Lig2 As Long, TabRes() As Variant, TabRech() As Variant 'Déclaration des variables

Application.Calculation = xlCalculationManual 'Désactive le recalcul auto de toutes le formules, le temps de la macro

With Sheets("MaFeuille") 'Nom feuille à adapter
    DerLig = .Range("A" & Rows.Count).End(xlUp).Row 'Détermine la dernière ligne
    DerLig2 = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row 'Détermine la dernière ligne du tableau de recherche
    .Columns("A:A").TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote 'convertir en nombre la colonne A
    .Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'insérer une colonne B
    TabRes = .Range("A2:B" & DerLig).Value 'Stocke les colonnes A et B dans une variable Tableau
    TabRech = Sheets("Feuil2").Range("A2:B" & DerLig2).Value 'Stocke les colonnes A et B du tableau de recherche
    .Range("B1") = "OOPS?" 'renommer le titre en OOPS?
    For Lig = 1 To DerLig - 1 'Parcourir les lignes
        For Lig2 = 1 To DerLig2 - 1 'Parcourir le tableau de recherche
            If TabRes(Lig, 1) = TabRech(Lig2, 1) Then TabRes(Lig, 2) = TabRech(Lig2, 2) 'Recherche de correspondance
        Next Lig2
    Next Lig
    .Range("A2:B" & DerLig).Value = TabRes
    MsgBox "Magasins Oops identifiés" 'afficher un message comme quoi la macro a bien fonctionné
End With

Application.Calculation = xlCalculationAutomatic 'Ré-active le recalcul auto de toutes le formules, le temps de la macro

End Sub
Le 31/07/2019 à 14:27

Pour la forme j'ai testé puisque tu as pris du temps pour créer le code.

Ca a l'air d'être un jeu pour toi tout ce charabia

Ca marche aussi bien. C'est aussi rapide (enfin dur à évaluer, peut-être un poil mieux), par contre ca a le gros avantage de laisser vide les cellules au lieu d'avoir des #N/A pas très jolis.

Testé et approuvé

merci!

Le 31/07/2019 à 14:39
evolm a écrit :

Ca a l'air d'être un jeu pour toi tout ce charabia

C'est une forme de jeu oui, des petits exercices pour m'améliorer un peu chaque jour !

Si les commentaires ne sont pas clairs et que tu souhaites plus d'explications, n'hésite pas...

Bonne continuation en tout cas !

Rechercher des sujets similaires à "optimiser macro enregistree"