Améliorer la rapidité de ma macro

Le 18/05/2020 à 15:39

Bonjour à tous,

Je suis novice en VBA et me suis aventurée dans la création d'un fichier dans le cadre de mon travail qui permet d'extraire une liste de produits sélectionnés.

Je vous explique :

  • sur 1 onglet, j'ai un tableau avec la liste complète de nos références, avec leurs informations principales et un visuel. Environ 2000 lignes.
  • sur 1 onglet, j'ai une liste de références à saisir (ce sont des références qui vont s'extraire de mon premier onglet)
  • sur 1 dernier onglet, j'ai mon modèle qui va me générer une feuille avec ma sélection

Tout fonctionne plutôt bien (petite victoire pour moi), cependant, 2 soucis :

  • La macro est très très lente... Elle peut prendre plus d'1/4 d'heure à se charger et le but est normalement de l'avoir en moins de 2 minutes. J'ai essayé de la ralentir en coupant les formules, comme conseillé sur plusieurs post du forum, mais comme mes deux premiers onglets sont liés par des formules, et ma macro ne fonctionne plus si je procède ainsi. Comment faire ?
  • Parfois, les images ne s'extraient pas correctement (un cadre blanc avec une croix rouge apparaît en haut à droite). Pourquoi ? et comment résoudre cela ?

Je vous ai joint un extrait de mon fichier pour que vous puissiez lire mes lignes de code.

J'espère avoir été claire dans mes explications et vous remercie d'avance pour votre aide !!

Camille

6creation-offre-2020.xlsm (84.64 Ko)
Le 18/05/2020 à 16:22

Salut le fil...

Elle s’arrête ta boucle ? Car si tu regardes la doc de Microsoft .Find boucle sur tous les éléments et reviens au début, donc tu dois récupérer ton adresse de départ et l'inclure dans ton Loop

Regardes l'exemple sur la doc de Microsoft

Le 18/05/2020 à 17:33

Bonjour,

voici ce que je te propose

1) mettre ta macro dans un module indépendant des feuilles, qualifier toutes tes plages en incluant le nom de la feuille

2) ta première boucle, je suppose qu'elle sert à remplacer les formules par leur résultat. cela peut se faire sans boucle et cela va aller beaucoup plus vite

with sheets("liste").usedrange
.value=.value
end with

3) faire une boucle avec find et findnext, plutôt que de faire une boucle dans laquelle tu supprimes les lignes que tu as traitées.

4) l'affichage de shapes dure longtemps s'il y en a beaucoup sur une feuille active, essaie de l'afficher le plus tard possible.

5) à suivre ...

Le 19/05/2020 à 10:12

Bonjour,

Tout d'abord, un grand merci pour vos réponses.

Je tente d'appliquer vos conseils.

h2so4, je suis parvenue à appliquer les deux premiers points conseillés. Concernant les deux derniers, je ne parviens pas réellement à les coder. Pouvez-vous, svp, m'aider à comprendre comment appliquer ma boucle avec find et findnext ? Et que voulez vous dire dans votre point 4) ?

Voici où j'en suis :

Sub CutData()

With Sheets("liste").UsedRange

.Value = .Value

End With

With Sheets("complet").UsedRange

.Value = .Value

End With

Dim MotCle

Dim i As Byte

Dim C As Range

Dim F As String

Dim Ligne As Long

'On définit les mots clés

MotCle = Array("X")

'On effectue la recherche de chaque mot clé dans la colonne A de la sheet complet

With Worksheets("complet")

For i = 0 To UBound(MotCle)

Do

Set C = Worksheets("complet").Columns(1).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)

'Si le mot clé est trouvé

If Not C Is Nothing Then

'On définit le nom de la feuille où sera effectuée la copie

F = "offre"

With Worksheets(F)

'On définit la ligne où sera effectué le collage

Ligne = .Range("F" & Rows.Count).End(xlUp).Row + 1

'On effectue le copier / coller

C.EntireRow.Copy .Range("A" & Ligne)

'On supprime la ligne dans la sheet1

C.EntireRow.Delete

End With

End If

Loop While Not C Is Nothing

Next i

End With

Workbooks("Création_offre_2020").Sheets("offre").Copy

End Sub

Déjà, en appliquant les deux premiers points, j'ai énormément gagné en rapidité ! Merci encore !!

Camille

Le 19/05/2020 à 10:58

Bonjour,

voici une proposition d'adaptation de ton code (je ne l'ai pas testé)

Sub CutData()
    Dim dict As Object
    Dim MotCle
    Dim i As Byte
    Dim C As Range, premierC As String
    Dim F As String
    Dim Ligne As Long
    Dim plagerecherche As Range
    Set dict = CreateObject("scripting.dictionary") 'dictionnaire contenant le numéro des lignes déja traitées (cas de recherche de plusieurs mots clés)

    With Sheets("liste").UsedRange
        .Value = .Value
    End With

    With Sheets("complet").UsedRange
        .Value = .Value
    End With

    'On définit les mots clés
    MotCle = Array("X")

    'On effectue la recherche de chaque mot clé dans la colonne A de la sheet complet
    With Worksheets("complet")
        Set plagerecherche = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    End With
    'On définit le nom de la feuille où sera effectuée la copie
    F = "offre"
    With Worksheets(F)
        Ligne = .Range("F" & Rows.Count).End(xlUp).Row
        For i = 0 To UBound(MotCle)
            Set C = plagerecherche.Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
                premierC = C.Address
                Do
                    If Not dict.exists(C.Row) Then 'déjà traité ?
                        'non
                        'On définit la ligne où sera effectué le collage
                        Ligne = Ligne + 1
                        'On effectue le copier / coller
                        C.EntireRow.Copy .Range("A" & Ligne)
                        dict.Add C.Row, "traité"
                    End If
                    ' on cherche la prochaine occurrence du mot clé
                    Set C = plagerecherche.FindNext(C)
                Loop While C.Address <> premierC
            End If
        Next i
    End With
    Workbooks("Création_offre_2020").Sheets("offre").Copy
End Sub

j'ai oté la suppression de lignes traitées dans la feuille C (Ce n'est pas nécessaire au vu de ce code, mais je n'ai pas tout le contexte)

Le 19/05/2020 à 12:32

Bonjour,

Merci à toi pour ton aide et le temps consacré à mon problème. Pour ma part, sur mon PC, cela fonctionne parfaitement ! Il me reste encore 2 soucis :

- J'ai envoyé ce fichier par mail à mon collègue. Chez lui, la macro ne se lance pas et il obtient un message d'erreur : "Erreur d'exécution "9" : L'indice n'appartient pas à la sélection". Il n'a pourtant renommé aucun onglet ni même le classeur. Savez-vous d'où peut venir cette erreur ?

- Autre soucis : la plupart des images ne s'affichent pas. Elles sont matérialisées par un cadre blanc avec une croix rouge en haut. J'ai réduit la taille des images (96 ppp) mais le problème persiste. Une idée de la cause ? Elles sont pourtant bien présente dans ma liste, mais pas dans mon extraction

Camille

Le 19/05/2020 à 12:57

bonjour,

- J'ai envoyé ce fichier par mail à mon collègue. Chez lui, la macro ne se lance pas et il obtient un message d'erreur : "Erreur d'exécution "9" : L'indice n'appartient pas à la sélection". Il n'a pourtant renommé aucun onglet ni même le classeur. Savez-vous d'où peut venir cette erreur ?

sur quelle instruction ?

celle-ci

Workbooks("Création_offre_2020").Sheets("offre").Copy

vérifie que le classeur s'appelle bien ainsi.

Autre soucis : la plupart des images ne s'affichent pas. Elles sont matérialisées par un cadre blanc avec une croix rouge en haut. J'ai réduit la taille des images (96 ppp) mais le problème persiste. Une idée de la cause ? Elles sont pourtant bien présente dans ma liste, mais pas dans mon extraction

Le message d'erreur indique que les images ne s'affichent pas car le lien vers le fichier image n'est pas correct.En l'occurrence, pour ce cas ci, l'emplacement devant recevoir l'image est défini, mais le lien vers l'image semble absent. Pour certaines images, ce n'est pas un lien vers le fichier image qui est utilisé, mais c'est toute l'image elle-même qui est sauvée dans le classeur. Ces images-là s'affichent bien.

Rechercher des sujets similaires à "ameliorer rapidite macro"