[VBA] - Réduire le temps d'exécution d'un code

Bonjour,

J'ai un code qui met beaucoup de temps à s'exécuter et j'aimerais savoir si vous connaîtriez une méthode pour optimiser son exécution. Ou bien une meilleure procédure ?

Le code en question c'est celui-ci :

    Set dc = Sheets("Database complete")
    Set ds = Sheets("Database synonymes complete")
    Set co = Worksheets("Correspondances")

    Dim ii As Integer, vv As Variant
            derLn = dc.Range("A" & Rows.Count).End(xlUp).Row
            derLn2 = ds.Range("A" & Rows.Count).End(xlUp).Row

    If CheckBox1.Value = False And CheckBox2.Value = False And CheckBox3.Value = False Then
    MsgBox "Aucun choix n'a été coché", vbOKOnly, "Erreur"
    End If

    If CheckBox1.Value = True And CheckBox2.Value = False And CheckBox3.Value = False Then
            For ii = 2 To co.Range("C" & Rows.Count).End(xlUp).Row
                nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), co.Range("C" & ii))
                nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), co.Range("C" & ii))

                If nb = 0 Then
                    If nb2 > 0 Then
                    End If
                    If nb2 = 0 Then
                        co.Range("D" & ii) = "Code erroné"
                    End If
                ElseIf nb = 1 Then 'And nb < 2 And nb <> 0
                    On Error Resume Next
                        vv = Application.WorksheetFunction.VLookup(co.Cells(ii, 3), Sheets("Database complete").Range("A:G"), 7, 0)
                        co.Cells(ii, 4) = IIf(IsError(vv), 0, vv)
                End If
            Next ii
'etc.

Ce qu'il fait :

Compter (= nb et nb2) le contenu de la cellule : "co.Range("C" & ii)" dans les deux bases de données [ dc.Range("A2:A" & derLn ou ds.Range("B2:B" & derLn2) ]

Si "nb" est trouvé 0 fois et "nb2" plus de 0 fois : rien (ici)

Si "nb" est trouvé 0 fois et "nb2" 0 fois : écrire "code erroné"

Si "nb" est trouvé plus d'1 fois : rien (ici)

Si nb est trouvé 1 seule fois : écrire la correspondance.

Je peux créer un document de travail si besoin ! Il sera nécessairement très lourd pour pouvoir fonctionner.

Merci de votre attention,

Bonne journée !

Bonjour

Le mieux serait d'avoir un fichier mais voici quelques remarques sur le code

  • Mettez le nom de votre feuille devant les ROWS.COUNT --> exemple : derLn = dc.Range("A" & dc.Rows.Count).End(xlUp).Row
  • L'instruction If nb2 > 0 Then...End If ne sert à rien puisque vous ne faites rien dans ce cas.

Un truc à essayer plutot que ceci --> For ii = 2 To co.Range("C" & co.Rows.Count).End(xlUp).Row

  • Définir la plage à boucler --> Set Plage = co.range("C1:C" & co.Range("C" & co.Rows.Count).End(xlUp).Row)
  • Ensuite vous faites ceci : For each cel in plage
  • plus bas dans le code remplacez le ii par cel.row

il y a surement encore mieux à faire

Cordialement

Bonjour,

Merci pour la proposition de modification. Hélàs, en appliquant ce que vous indiquez, le code prend 1 minute de plus à s'exécuter haha.

Je vais voir pour proposer un document à télécharger !

Bonjour,

J'ai créé un document de travail et lorsque j'exécute le même code celui-ci est achevé en 18secondes.

Dans mon document initial ce code est réalisé en 1min 40sec.

Via cjoint, je vous transmets mon document de travail, mais il n'est pas représentatif de la réalité et je ne sais pas pourquoi...

Lien cjoint : https://cjoint.com/c/ILniWt75R8B

Sur mon document de base j'utilise bien :

ScreenUpdating = False

Seules les bonnes variables sont déclarées et toute dans "Option Explicit".

Ça ne vient donc pas de ça.

Est-ce que ça peut provenir de la mémoire qui serait saturée ?

A plus tard

Bonjour

cela râme déjà à l'ouverture du fichier !

1er point, pourquoi avez vous un tableau dans la feuille Correspondance qui s'établiet sur 16000 colonnes ?

2ieme point, à l'ouverture du fichier on reçoit un message que le fichier est lié à un autre. Là c'est le genre de truc à ne pas faire du tout. Possible de supprimer cela ?

Cordialement

Bonjour,

Oui j'ai ce message assez souvent, mais le document n'est lié à rien.

32 000 colonnes ? Mon tableau s'arrête à la colonne M mais en faisant un copier-coller de mon tableau initial en sélectionnant toute la feuille j'ai créé un tableau sur 32 000 colonnes en effet... (mais ça ne concerne que l'exemple).

Re

Oui j'ai ce message assez souvent, mais le document n'est lié à rien.

Si dans les liaisons --> Menu fichier -> Informations -> en bas de la fenetre --> Liaisons. Là c'est ok j'ai supprimé

pour les colonnes j'ai adapté aussi

Questions :

  • dans vos userform vous utilisez l'instruction HIDE. Pourquoi ?
  • Lorsque vous lancer le code Sub corresperr, quelle est la feuille active ?
  • combien de temps met votre code ?

Cordialement

Bonjour,

Dans mon document je n'arrive pas à rompre les liaisons. Et je peux effectivement ouvrir le document lié, qui n'a aucun intérêt ^^'

dans vos userform vous utilisez l'instruction HIDE. Pourquoi ?

Je les utilise pour 3 UF, mais on peut effectivement utiliser unload.

Lorsque vous lancer le code Sub corresperr, quelle est la feuille active

La feuille "Correspondances"

combien de temps met votre code ?

Il met 1 minute et 47 secondes sur mon document complet.

Et il peut arriver que mon document m'affiche "mémoire insuffisante", mais je ne parviens pas à savoir dans quelles circonstances.

Bonne journée

Bonjour,

Je ne parvenais pas à rompre la liaison avec un autre document, j'ai donc uilisé la solution proposé par un utilisateur du site "Commentçamarche" à savoir :

Bonjour,

je viens de résoudre le problème de manière inattendue pour des liaisons hyper récalcitrante, et après que toutes les autres solutions énoncées dans ce forum ont été épuisées.

Voici le principe :

1. Ouvrir le fichier contenant les liaisons récalcitrantes. Appelons-le Fichier1.xlsm.

2. Dans Fichier/Propriétés, identifier le nom et l'emplacement du fichier Excel vers lequel se trouvent les liaisons (appelons-le Fichier2.xlsm), puis fermer Fichier1.xlsm.

3. Sous Windows, faire une copie de Fichier1.xlsm sous le nom et à l'emplacement de Fichier2.xlsm.

4. Ouvrir Fichier2.xlsm : il pointe donc vers lui même et ne contient donc plus aucune liaison !

5. Sauvegarder Fichier2.xlsm sous le nom et à l'emplacement initial de Fichier1.xlsm.

Damien

J'utilise

Unload.Me

pour décharger tous les UserForm.

Le code prend 1minute 08 à s’exécuter.

C'est toujours pas les 18secondes de mon document de travail.

J'hésite à repartir d'un document vierge et recopier étape par étape les différents codes...

Bonjour

Votre fichier en retour et dans lequel j'ai supprimé les liaisons.

Après test, le code est exécuté entre 12 et 15 secondes

Faites le test sur le fichier que je vous envoie.

Pour l'instruction HIDE : L'userform est cachée à l'arrière plan. UNLOAD elle est déchargée ce qui est mieux si vous n'en avez pas besoin dans la suite du code

Cordialement

Bonsoir,

J'ai testé votre solution qui a été exécuté en 13 secondes dans mon document complet.

C'est déjà une très bonne nouvelle

Mais en plus, je pense que je vais pouvoir adapter plusieurs partie de mon code qui fonctionne de la même manière que celui que vous avez modifié, ce qui pourrait faire gagner à nouveau beaucoup de temps dans certaines situations !

(Pour mon premier test Excel a crash, mais c'est surement normal )

Bonne fin de journée,

Merci beaucoup de votre aide !

Une petite question.

Lorsque j'essaie d'adapter votre solution à l'une des parties de mon document j'ai l'erreur "l'indice n'appartient pas à la sélection".

Alors j'ai repris ce code et l'ai testé dans le document de travail (celui que vous m'avez renvoyé) et j'ai bien la même erreur.

Le code en question est celui là :

(Option explicit)

Option Explicit
Dim fb As Worksheet, sa As Worksheet, dc As Worksheet, ds As Worksheet, co As Worksheet ', tv As Worksheets
Dim lrfb&, lrco&, lrsa&, r&, derLn&, derLn2&, nb&, nb2&, lcco&, i&, ee&
Dim cib1%
Dim ii2%, vv2 As Variant, cel As Variant, Rep As Variant, vv As Variant
Dim Plage As Range
Dim tablo As Variant, tablo1 As Variant
Dim MacroDebut, MacroEtape1, MacroEtape2, MacroEtape3, MacroFin, _
MacroEtape1_duree, MacroEtape2_duree, MacroEtape3_duree, MacroTotal_duree
Sub corresperr()

Set co = Worksheets("Correspondances")
Set dc = Worksheets("Database complete")
Set ds = Worksheets("Database synonymes complete")

lrco = co.Cells(Rows.Count, 4).End(xlUp).Row
lcco = co.Cells(1, co.Columns.Count).End(xlToLeft).Column

derLn = dc.Range("A" & Rows.Count).End(xlUp).Row
derLn2 = ds.Range("A" & Rows.Count).End(xlUp).Row

For cib1 = 1 To lcco
    If Cells(1, cib1) = "Correspondance" Then
    Exit For
    End If
Next cib1
        'For ee = 2 To lrco

        derLn = dc.Range("A" & Rows.Count).End(xlUp).Row
        derLn2 = ds.Range("A" & Rows.Count).End(xlUp).Row

        tablo1 = co.Range("C2:C" & co.Range("A" & co.Rows.Count).End(xlUp).Row)

        For ee = 2 To UBound(tablo1)
            If co.Cells(ee, cib1) = "" Then
                nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), tablo1(ee, 3))
                nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), tablo1(ee, 3))

                If nb = 0 Then
                    If nb2 > 0 Then
                        'co.Range("D" & i) = "Synonymes"
                        tablo1(ee, 4) = "Synonymes"
                    ElseIf nb2 = 0 Then
                        'co.Range("D" & ii) = "Code erroné"
                        tablo1(ee, 4) = "Code erroné"
                    End If
                    ElseIf nb >= 2 Then
                        'co.Range("D" & ii) = "Codes jumeaux"
                        tablo1(ee, 4) = "Codes jumeaux"
                    ElseIf nb = 1 And nb < 2 And nb <> 0 Then
                    On Error Resume Next
                        vv = Application.WorksheetFunction.VLookup(tablo1(ee, 3), Sheets("Database complete").Range("A:G"), 7, 0)
                        'co.Cells(ii, 4) = IIf(IsError(vv), 0, vv)
                        tablo1(ee, 4) = IIf(IsError(vv), 0, vv)
                    End If

 '                       nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), co.Range("C" & ee)) 'co.Range("C" & ii))
 '                       nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), co.Range("C" & ee))
 '                       If nb = 0 Then
 '                           If nb2 > 0 Then
 '                               co.Cells(ee, cib1) = "Synonymes"
 '                           ElseIf nb2 = 0 Then
 '                               co.Cells(ee, cib1) = "Code erroné"
 '                           End If
 '                       ElseIf nb >= 2 Then
 '                           co.Cells(ee, cib1) = "Codes jumeaux"
 '                       ElseIf nb = 1 And nb < 2 And nb <> 0 Then
 '                           On Error Resume Next
 '                           vv = Application.WorksheetFunction.VLookup(co.Cells(ee, cib1 - 1), Sheets("Database complete").Range("A:G"), 7, 0)
 '                           co.Cells(ee, cib1) = IIf(IsError(vv), 0, vv)
 '                       End If
            End If
        Next ee
End Sub

Vous voyez ce qu'Excel n'arrive pas à trouver ? Il me semble que j'ai pas changé grand chose (i est devenu ee ; tablo est devenu tablo1 car j'utilisais déjà ces références).

Edit : en fait ça vient de :

tablo1 = co.Range("C2:C" & co.Range("A" & co.Rows.Count).End(xlUp).Row)

où on utilise uniquement la colonne C et quand j'exécute cette partie du code :

nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), tablo1(ee, 3))

Il y a une erreur car tablo ne comprend qu'une seule colonne. (colonne 3 n'existe pas).

Mais alors pourquoi est-ce que ça fonctionne sur le document de travail...

Edit 2 : j'ai remplacé tablo(i, 3)) par co.Range("C" & i)).

ici : nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), co.Range("C" & ee))

Ça n'engendre plus d'erreur, mais le résultat n'est pas renseigné dans la cellule, car l'indice n'appartient pas à la sélection, étant donné que "tablo" n'a qu'une seule colonne.

Bonne soirée !

Re

Donnez moi le vrai fichier, c'est mieux pour voir où est le souci

Je vois vous avez une multitude de variables. A quoi cela sert ? de plus pourquoi les mettre en en tête du module si vous ne les utilisez que sur un seul code ?

Cordialement

Je les utilise dans différents modules, certaines plusieurs fois et certain une seule fois.

Dès le départ je les ai tous mis en haut et je n'ai pas pris le temps de tout reclasser.

Lorsque j'ai commencé le code de ce document, je ne savais pas que je pouvais utiliser plusieurs fois la même variable, alors j'en créais une multitude...

Voici le lien vers le nouveau document :

https://cjoint.com/c/ILsqDgQK6mB

Bonne fin de journée !

Bonjour

Edit 2 : j'ai remplacé tablo(i, 3)) par co.Range("C" & i)).

ici : nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), co.Range("C" & ee))

Ça n'engendre plus d'erreur, mais le résultat n'est pas renseigné dans la cellule, car l'indice n'appartient pas à la sélection, étant donné que "tablo" n'a qu'une seule colonne.

Vous avez bien fait car ce problème se trouvait dans la deuxième partie du code (dans le ESLIF) et je ne l'avais pas corrigé

Quels sont les codes que vous utilisez car on voit bien que vous faites des tests ci et là ?

Cordialement

Bonjour,

Dans le document que j'ai transmis, le code qui est actuellement testé est le "Sub corresperr()"

En appuyant sur OK dans l'UF, il est automatiquement exécuté.

Ce code est censé faire la même chose que celui que vous avez modifié, mais il ne doit s'exécuter que si une cellule est vide en colonne D (Correspondance).

Le problème c'est que lorsque le code est exécuté pas à pas, on peut voir que :

tablo1(ee, 3) ou tablo1(ee, 4) n'appartiennent pas à la sélection.

Dans ce cas là, tablo n'a pas les bonnes dimensions on dirait. Pourtant ça marchait avec votre code

re

Je ne vois pas pourquoi vous voulez changer si ce que je vous ai donné fonctionne

Dans votre code "Correp", pourquoi utiliser vous une boucle au départ

For cib1 = 1 To lcco
    If Cells(1, cib1) = "Correspondance" Then
    Exit For
    End If
Next cib

Je vais analyser ce que vous cherchez à faire pour essayer de simplifier

Cordialement

La boucle au départ identifie la bonne colonne, car mon document peut évoluer durant l'utilisation et je veux éviter de désigner une colonne par son numéro car ça engendre des erreurs par la suite.

Dans cette feuille correspondances, cette boucle n'est pas nécessaire car les colonnes sont toujours les mêmes jusqu'à la 4ème colonne. On est pas obligé de la laissé effectivement, mais c'est pas bien long à exécuter ^^

Dans corresperr, si la cellule en colonne 4 est vide alors exécuter le code. Il ressemble à celui que vous avez fait, sauf qu'il ajoute deux cas :

Si nb = 0 ET nb2 > 0 alors écrire "Synonymes" dans la cellule correspondante.

Si nb >= 2 alors écrire "Codes jumeaux" dans la cellule correspondante.

Le reste fonctionne pareil normalement.

Bonjour

J'ai revu votre code en fonction de votre message. Le code modifié est placé dans le module 2

La boucle est supprimée et remplacée par cette ligne

cibl = co.Rows("1:1").Find("Correspondance", LookIn:=xlValues).Column

Après un test, le code est exécuté en 2 secondes max. A verifier de votre côté si le resultat est celui attendu.

Voici le fichier en retour à tester

Cordialement

Bonjour,

J'ai pu faire quelques tests en adaptant toutes les parties de mon code qui le pouvaient.

Dans certaines situations, vous me faites gagner presque deux minutes dans l'exécution du code ! C'est un gain vraiment énorme !

Dans l'exécution d'une seconde partie de mon code, la différence est de 1 seconde C'est toujours ça de gagné ! L'ancien code prenait 16 seconde, celui-ci 15.

Première partie mettait 35 secondes, => 34 secondes

Seconde partie : 1min 45sec => 4 secondes

Par contre je ne comprends pas pourquoi on utilise tablo dans le premier code corrigé et qu'on ne l'utilise plus ensuite (l'option avec tablo est plus rapide).

Il me reste a corriger les erreurs que j'ai créé en trifouillant tout le code...

Merci beaucoup pour votre aide !

Bon week end, bonne fêtes !

Rechercher des sujets similaires à "vba reduire temps execution code"