[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
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 !