[VBA] - Réduire le temps d'exécution d'un code
Bonjour,
Finalement je pense qu'en utilisant tablo, aucun code ne fonctionne. tablo ne désigne qu'une seule colonne et les changements sont fait sur plusieurs colonnes.
Lorsque j'utilise ce code par exemple :
tablo = co.Range("C1:D" & co.Range("A" & co.Rows.Count).End(xlUp).Row)
If UserForm5.CheckBox1.Value = True And UserForm5.CheckBox2.Value = False And UserForm5.CheckBox3.Value = False Then
'For ii = 2 To co.Range("C" & co.Rows.Count).End(xlUp).Row
'Set Plage = co.Range("C2:C" & co.Range("C" & co.Rows.Count).End(xlUp).Row)
For i = 2 To UBound(tablo)
nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), co.Range("C" & i))
nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), co.Range("C" & i))
If nb = 0 Then
If nb2 = 0 Then
tablo(i, 2) = "Code erroné"
End If
ElseIf nb = 1 Then
On Error Resume Next
vv = Application.WorksheetFunction.VLookup(tablo(i, 1), Sheets("Database complete").Range("A:G"), 7, 0)
tablo(i, 2) = IIf(IsError(vv), 0, vv)
End If
Next iLes modifications ne sont pas appliquées dans le tableau, au final tout le traitement est fait, mais rien ne change dans mes données.
C'est encore moi.
J'ai finalement repris le code en essayant d'utiliser tablo, et j'ai un résultat qui fonctionne et qui prend 14secondes à s'exécuter.
Sub test1OK()
Set dc = Sheets("Database complete")
Set ds = Sheets("Database synonymes complete")
Set co = Worksheets("Correspondances")
'Set ve = Sheets("vitesseexec")
MacroDebut = Now
'#################################"""
'Dim dico
Dim Plg As Range
Dim cel As Variant, d As Variant
Dim b%
Dim lrco&, lcco&
Dim ii As Integer, vv As Variant
derLn = dc.Range("A" & dc.Rows.Count).End(xlUp).Row
derLn2 = ds.Range("A" & ds.Rows.Count).End(xlUp).Row
lrco = co.Cells(Rows.Count, 2).End(xlUp).Row
lcco = co.Cells(1, co.Columns.Count).End(xlToLeft).Column
Set dico = CreateObject("Scripting.dictionary")
Set tablo = co.Range(Cells(2, 3), Cells(lrco, 3))
If UserForm5.CheckBox1.Value = True And UserForm5.CheckBox2.Value = False And UserForm5.CheckBox3.Value = False Then
For Each cel In tablo
nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), cel) 'co.Range("C" & i)
nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), cel) 'co.Range("C" & i)
If nb = 0 Then
If nb2 = 0 Then
cel(1, 2) = "code erroné"
End If
ElseIf nb = 1 Then
On Error Resume Next
vv = Application.WorksheetFunction.VLookup(cel(1, 1), Sheets("Database complete").Range("A:G"), 7, 0)
cel(1, 2) = IIf(IsError(vv), 0, vv)
End If
Next cel
ElseIf UserForm5.CheckBox1.Value = True And UserForm5.CheckBox2.Value = True Or UserForm5.CheckBox1.Value = True And UserForm5.CheckBox3.Value = True Then
Rep = MsgBox("Vous avez coché ""Codes jumeaux"" et/ou ""Codes synonymes"", cela signifie que si vous poursuivez, tous les codes concernés seront réinitialisés. Voulez-vous poursuivre", vbYesNo + vbExclamation, "Alerte")
If Rep = vbYes Then
'For ii = 2 To co.Range("C" & co.Rows.Count).End(xlUp).Row
'For i = 2 To UBound(tablo)
For Each cel In tablo
nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), cel) 'tablo(i, 3))
nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), cel) 'tablo(i, 3))
If nb = 0 And UserForm5.CheckBox2.Value = True Then
If nb2 > 0 Then
'co.Range("D" & i) = "Synonymes"
cel(1, 2) = "Synonymes"
ElseIf nb2 = 0 Then
'co.Range("D" & ii) = "Code erroné"
cel(1, 2) = "code erroné"
End If
ElseIf nb >= 2 And UserForm5.CheckBox3.Value = True Then
'co.Range("D" & ii) = "Codes jumeaux"
cel(1, 2) = "Codes jumeaux"
ElseIf nb = 1 And nb < 2 And nb <> 0 Then
On Error Resume Next
vv = Application.WorksheetFunction.VLookup(cel(1, 1), Sheets("Database complete").Range("A:G"), 7, 0)
'co.Cells(ii, 4) = IIf(IsError(vv), 0, vv)
cel(1, 2) = IIf(IsError(vv), 0, vv)
End If
Next cel
ElseIf Rep = vbNo Then
Exit Sub
End If
End If
'MacroEtape1 = Now
'corresperr
'MacroEtape2 = Now
'style
'MacroEtape3 = Now
'RechErr
MacroFin = Now
'MacroEtape1_duree = Format(MacroEtape1 - MacroDebut, "hh:mm:ss")
'MacroEtape2_duree = Format(MacroEtape2 - MacroEtape1, "hh:mm:ss")
'MacroEtape3_duree = Format(MacroEtape3 - MacroEtape2, "hh:mm:ss")
MacroTotal_duree = Format(MacroFin - MacroDebut, "hh:mm:ss")
MsgBox _
"Durée partie 1: " & MacroEtape1_duree & Chr(10) & _
"Durée partie 2: " & MacroEtape2_duree & Chr(10) & _
"Durée partie 3: " & MacroEtape3_duree & Chr(10) & Chr(10) & Chr(13) & _
"Durée totale: " & MacroTotal_duree
Unload UserForm5
End SubC'est un premier test, il reste à vérifier que ça fonctionne dans tous les cas de figure et que ça ne prend pas trop de temps dans mon document complet.
A plus tard
Edit : Ça prend 1m08sec maintenant...
J'ai essayé avec un dictionnaire, mais il ne prend pas en compte les doublons et c'est trop long de récupérer les infos pour chaque doublons par la suite.
Alors j'ai testé la collection, mais ça ne fonctionne pas visiblement :
Sub test1OK()
Set dc = Sheets("Database complete")
Set ds = Sheets("Database synonymes complete")
Set co = Worksheets("Correspondances")
MacroDebut = Now
Dim col As New Collection
Dim Plg As Range
Dim cel As Variant, d As Variant
Dim b%
Dim lrco&, lcco&
Dim ii As Integer, vv As Variant
derLn = dc.Range("A" & dc.Rows.Count).End(xlUp).Row
derLn2 = ds.Range("A" & ds.Rows.Count).End(xlUp).Row
lrco = co.Cells(Rows.Count, 2).End(xlUp).Row
lcco = co.Cells(1, co.Columns.Count).End(xlToLeft).Column
Set tablo = co.Range(Cells(2, 3), Cells(lrco, 3))
'Set dico = CreateObject("Scripting.dictionary")
Set col = New Collection
'col.Remove
If UserForm5.CheckBox1.Value = True And UserForm5.CheckBox2.Value = False And UserForm5.CheckBox3.Value = False Then
For Each cel In tablo
nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), cel) 'co.Range("C" & i)
nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), cel) 'co.Range("C" & i)
If nb = 0 Then
If nb2 = 0 Then
'cel(1, 2) = "code erroné"
'If Not dico.exists(cel.Value) Then
col.Add ("Code erroné") ', "code erroné" 'cel.Value
'End If
End If
ElseIf nb = 1 Then
On Error Resume Next
vv = Application.WorksheetFunction.VLookup(cel(1, 1), Sheets("Database complete").Range("A:G"), 7, 0)
'If Not dico.exists(cel) Then
col.Add vv 'IIf(IsError(vv), 0, vv) 'cel(1, 2) = IIf(IsError(vv), 0, vv)
'End If
End If
Next cel
If co1.Count > 0 Then
b = 2
For i = 2 To co1.Count
'For Each d In col
'Range("D" & b) = d
co.Cells(i, 4) = col(i)
b = b + 1
Next i
End IfRe
Finalement je pense qu'en utilisant tablo, aucun code ne fonctionne. tablo ne désigne qu'une seule colonne et les changements sont fait sur plusieurs colonnes.
Cela n'a rien à voir.
Je ne comprends pourquoi vous changez continuellement ce que je vous donne.
Lorsque l'usf 5 apparait en feuille Correspondant et que vous cliquez sur Ok, l'exécution du code, complète bien la colonne D des mots définis.
Dans votre dernier post, vous mettez cette instruction
If UserForm5.CheckBox1.Value = True And UserForm5.CheckBox2.Value = False And UserForm5.CheckBox3.Value = Ou se trouve-t-elle dans votre fichier car dans l'userform5 on a ceci :
Private Sub CommandButton1_Click()
'test1OK
corresperr
End SubDans votre dernier post on également ceci :
lrco = co.Cells(Rows.Count, 2).End(xlUp).Row
lcco = co.Cells(1, co.Columns.Count).End(xlToLeft).ColumnCes deux variables ne sont reprises nulle par dans votre code... et donc ne servent pas
Autre chose dans le code
cel(1, 2) = "code erroné"Pourquoi vous mettez "code erroné" dans la colonne B ?? ce n'est pas dans la colonne D ??
Je vous ai placé un fichier avec la macro "corresp", quand vous exécutez le code dites moi ce qui n'est pas juste.
Si vous avez un fichier différent on ne va jamais y arriver
Bonjour,
Je ne change pas les codes, il y a un soucis avec son exécution et je ne l'avais pas vu au départ.
Le premier code que vous proposiez :
tablo = co.Range("C2:C" & co.Range("C" & co.Rows.Count).End(xlUp).Row)
For i = 2 To UBound(tablo)
nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derln), co.Range("C" & i))
nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derln2), co.Range("C" & i))
If nb = 0 Then
If nb2 = 0 Then
'co.Range("D" & i) = "Code erroné"
tablo(i, 3) = "Code erroné"
End If
ElseIf nb = 1 Then 'And nb < 2 And nb <> 0
On Error Resume Next
vv = Application.WorksheetFunction.VLookup(tablo(i, 3), Sheets("Database complete").Range("A:G"), 7, 0)
tablo(i, 4) = IIf(IsError(vv), 0, vv)
End If
Next iGénère une erreur sur cette ligne :
tablo(i, 3) = "Code erroné" car (3) désigne une colonne n°3 qui n'est pas délimitée dans tablo
co.Range("C2:C" & co.Range("C" & co.Rows.Count).End(xlUp).Row)
C'est pourquoi j'ai redéfini tablo pour éliminer l'erreur.
tablo = co.Range("C1:D" & co.Range("A" & co.Rows.Count).End(xlUp).Row)
tablo(i, 1) = colonne C
tablo(i, 2) = colonne D
lrco et lcco ce sont deux nouvelles variables que j'utilise pour délimiter tablo sans désigner de colonne particulière :
Set tablo = co.Range(Cells(2, 3), Cells(lrco, 3))
lrco j'ai oublié de l'enlever.
Tout ce que je postais, c'était différents tests.
Si cela vous va, je reupload le document que vous m'avez envoyé en modifiant 3 choses :
> Le code qui est exécuté est celui ci : module1 sub test1OK () (premier code que vous proposez, si celui-ci fonctionne les autres ne devraient pas poser de problème) (il est lancé dans l'UF5).
> Dans Private Sub UserForm_Initialize() j'ai désactivé ces deux lignes :
'CheckBox3.Enabled = False
'CheckBox2.Enabled = False> En ligne 2 colonne C j'ai écris : "Brac diss" (qui devra donner "Code erroné") et en ligne 3 "Rese lute" qui ne sera pas traité si seule la CheckBox1 est cochée dans l'UF5.
Je vous remercie de votre aide.
Bonne journée ! A plus tard
Re
Ce n'est pas le code que j'ai placé dans le module 2 comme dit avant
J'ai supprimé tablo(i, 3) = "Code erroné" au profit de co.Range("D" & i) = "Code erroné"
Dans l'usf5, si aucune case à cocher n'est cochée vous voulez que le code continue ou il doit être arrêté ?
Crdlt
Ah oui j'ai compris comment vous vous y étiez pris.
Dans l'usf5, si aucune case à cocher n'est cochée vous voulez que le code continue ou il doit être arrêté ?
Je traite cette éventualité via ce code. En faisant apparaître un MsgBox.
If UserForm5.CheckBox1.Value = False And UserForm5.CheckBox2.Value = False And UserForm5.CheckBox3.Value = False Then
MsgBox "Aucun choix n'a été coché", vbOKOnly, "Erreur"
End If
Donc, désormais on dirait que le code (re)fonctionne comme au départ, il me reste à voir si ça va toujours aussi vite dans mon document complet.
Re
Ok mais je dois savoir ce que vous voulez faire si aucun case n'est cochée car là le code continue après la msgbox.
Je vous renverrai le fichier modifié après
Le code est arrêté, et l'UF reste ouvert.
Re,
Voici votre fichier en retour.
Le code complet à utiliser se trouve dans le module 2 et est exécuté depuis l'USF5
après test, la macro est exécutée en 14 secondes
Le lien -->
Cordialement
Bonjour,
Votre code s'exécute comme prévu dans le document de travail.
Mais une fois exécuté dans mon document complet, en n'exécutant que lui, son exécution prend 2 minutes.
Il ne doit pas y avoir de solution... Ça ne provient certainement pas du code.
Vous savez ce qui peut rendre l'exécution du code plus lente ? Le poids du document, la mémoire qui est saturée ?
J'ai remarqué que lorsque je ferme des documents Excel, ils apparaissent toujours dans la fenêtre VBA. (Et si j'essaie de les ouvrir parfois je peux accéder au code (alors que le document est bien fermé) ou alors j'ai l'erreur "mémoire insuffisante". J'exécute également l'ensemble des sub depuis un module où toutes les variables sont déclarées dans Option Explicit. Peut-être devrais-je les classer dans plusieurs modules ?
Je vous remercie encore pour votre aide !
Bonjour
Vous savez ce qui peut rendre l'exécution du code plus lente ? Le poids du document, la mémoire qui est saturée ?
Votre fichier doit traiter trop de données et la mémoire est sollicitée.
J'ai remarqué que lorsque je ferme des documents Excel, ils apparaissent toujours dans la fenêtre VBA. (Et si j'essaie de les ouvrir parfois je peux accéder au code (alors que le document est bien fermé) ou alors j'ai l'erreur "mémoire insuffisante".
????? vous avez vraiment un souci avec votre mémoire PC à mon avis. Si un document excel est fermé vous ne devez plus le voir dans VBA bien sûr.
J'exécute également l'ensemble des sub depuis un module où toutes les variables sont déclarées dans Option Explicit. Peut-être devrais-je les classer dans plusieurs modules ?
Non, mais mettre des variables qui ne servent à rien ne va pas vous aider. Dans votre fichier j'avais déjà remarqué cela. Et le fait de les mettre en dessous de Option explicit vous aide encore moins puisqu'elles restent actives pendant l'exécution de tous vos codes. Il faut les mettre dans vos SUB comme je vous l'ai mis dans le code CORRESP.
Mettre vos variables en dessous de option explicite ne sert que si vous devez conserver la valeur lors de l'exécution de plusieurs codes.
Pour ce qui est deux minutes, j'ai l'impression que vous ne m'avez pas donné votre vrai fichier. Et là cela aurait aidé tout de même à comprendre voire à corriger.
Cordialement
Bonjour,
Vous avez exactement les mêmes données que moi, sauf pour une des deux bdd où j ai retiré 7000lignes pour avoir un document de 15mo. Normalement ça ne devrait pas être la source du problème.
Je vais reprendre toutes les variables pour simplifoer cette partie déjà. Ensuite je vais chercher d'où peut bien provenir le soucis avec les docupents fermés encore visibles.
Je viendrai poster le résultat !
Merci pour ces informations
Re
Vous avez exactement les mêmes données que moi, sauf pour une des deux bdd où j ai retiré 7000lignes pour avoir un document de 15mo. Normalement ça ne devrait pas être la source du problème.
ben voilà d'où vient la lenteur. Dans votre fichier que vous avez envoyé, le code boucle sur 645 lignes. Dans le réel il boucle sur 7000 lignes !!.
Les variables, prenez uniquement celle que j'ai déclarées et surtout placer les où je les ai mises
Crdlt
Non non, il ne s agit pas des 645 lignes, il s'agit d'une des deux bases de données qui sont utilisées (l'une est réduite de 5000lignes (synonymes).
Re
Je n'ai pas parlé des deux bases de données mais du code CORRESP qui lui, boucle sur les 645 lignes de la feuille Correspondance
Crdlt
Bonsoir,
J'ai modifié toutes les variables déclarées pour qu'elles apparaissent dans leurs sub approprié.
Supprimé une partie d'entre elles au passage ; et les ai retiré de la mémoire (via un Set variable = nothing à la fin de chaque sub (pour les variables qui ne sont plus utilisées par la suite).
Le code met 1 minute 47 secondes à s’exécuter en totalité dont 56 secondes pour l’exécution du code dont il est question ici.
C'est déjà un mieux, mais on est encore assez loin des temps enregistrés pour ce même code dans un autre document.
Merci pour vos conseil !
Bonjour,
J'ai aussi lu que les ".activate" ou les ".select" peuvent aussi utiliser de la mémoire. J'en utilise très peu.
Mais si éventuellement vous savez comment utiliser une autre solution...
Le code en question :
fb.Activate
fb.Range(Cells(2, 1), Cells(lrfb, lcfb)).RemoveDuplicates Columns:=Array(3, 4)
sa.Activate
sa.Range(Cells(2, 1), Cells(lrsa, lcsa)).RemoveDuplicates Columns:=Array(2, 3)Il ne me sert qu'à supprimer des colonnes devenues inutiles.
Autrement, je ne vois pas trop ce qui peut poser soucis.
Je risque de devoir reproduire le code, pas à pas, dans un autre document et voir à quel moment le temps d'exécution change.
Bonne journée !
Re
J'ai aussi lu que les ".activate" ou les ".select" peuvent aussi utiliser de la mémoire. J'en utilise très peu.
Mais si éventuellement vous savez comment utiliser une autre solution...
Si on peut éviter c'est mieux
Je ne sais où se trouve votre code dans le fichier mais il devrait être comme ceci (et oubliez pas les points devant les Range et cells !)
With fb
.activate
.Range(.Cells(2, 1), .Cells(lrfb, lcfb)).RemoveDuplicates Columns:=Array(3, 4)
End with
with sa
.activate
.Range(.Cells(2, 1), .Cells(lrsa, lcsa)).RemoveDuplicates Columns:=Array(2, 3)
End withCe que vous devriez faire c'est zipper votre fichier et me donner le fichier sur cjoint.
Juste de voir votre vrai fichier sans quoi on risque de tourner en rond dans votre problème
Crdlt
On ne peut pas se débarrasser des activates dans certaines circonstances on dirait..
Je vous ai transmis un document via cjoint.
Merci
Bonne journée !