Code VBA ralentissant une macro
Bonjour
Après avoir procédé par élimination, j'ai trouvé le code qui me ralentit considérablement ma macro.
Il s'agit d'un code que j'ai mis et qui travaille sur une feuille d'un classeur, puis le même code sur une deuxième feuille et qui me permet de transformer le contenu d'une cellule de x lettres en seulement 3 lettres dans une autre cellule ( exemple : CNE1ER = CNE) et ce sur environ 300 lignes.
Ci joint le code qui pourrait peut être être modifier ??
[code]'Dim a As String
'Dim b As String
'Dim c As String
'Dim LiFin(2) As Long
'Dim x As Long
'Dim y As Long
'LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
'LiFin(2) = Cells(Rows.Count, 1).End(xlUp).Row
'For x = 1 To LiFin(2)
'c = c & "µ" & Cells(x, 1)
'Next x
'c = c & "µ"
'For x = 2 To LiFin(1)
'a = Cells(x, 4)
'If InStr(1, c, a) > 0 Then
'Cells(x, 3) = a
'Else
'Cells(x, 3) = Mid(a, 1, 3)
'End If
'Next x
/code]
[code]'Dim a As String
'Dim b As String
'Dim c As String
'Dim LiFin(2) As Long
'Dim x As Long
'Dim y As Long
'LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
'LiFin(2) = Cells(Rows.Count, 1).End(xlUp).Row
'For x = 1 To LiFin(2)
'c = c & "µ" & Cells(x, 1)
'Next x
'c = c & "µ"
'For x = 2 To LiFin(1)
'a = Cells(x, 4)
'If InStr(1, c, a) > 0 Then
'Cells(x, 3) = a
'Else
'Cells(x, 3) = Mid(a, 1, 3)
'End If
'Next x
/code]
Bonjour Tacentaure
Je n'ai rien compris de la finalité de ton code "qui ralentit", mais pour accélérer (à mon avis) un traitement de ce genre...
Il faut créer une fonction dans un module standard et non dans chaque module de feuille, quelque chose de ce genre...
Function TransformeEnTroisLettres(cel As Range)
Dim...
Application.Volatile ' pour permettre la prise en compte de cette fonction dans les calculs automatiques
' ici le code de la fonction
TransformeEnTroisLettres = resultatDuTraitementRealiseCiDesus
End Function
Et ensuite à chaque fois que tu as besoin de réaliser ce "3 lettres" tu utilises la fonction TransformeEnTroisLettres comme une formule Excel classique :
= TransformeEnTroisLettres( <= une référence de cellule )
Bonjour,
Poste un classeur avec tes chaînes de lettres, ça sera plus facile pour t'aider. Par exemple, je ne comprend pas l'intérêt de l'insertion du caractère "µ" ? Qui ensuite n'est pas utilisé !
Le fichier qui cache les lettres en exemple.
Placé dans un userform,le code ralentit considérablement la macro globale
Bonjour Tacentaure,
Idem je ne comprend pas l'interet du caractere µ dans ta macro, tu pourrais nous éclairer?
Le mieux est probablement de passer par une fonction, ou a defaut dans un premier temps arreter de travailler sur ta feuille! L'idée en VBA c'est d'intéragir un minimum avec l'interface excel.
Par exemple, récupérer une valeur, ou 1000 valeurs sur une feuille mettra grosso modo le meme temps d'execution. Il vaut mieux du coup récupérer la totalité de tes valeurs en un coup en les passant dans un tableau VBA, puis traiter ton tableau VBA et coller le resultat.
Ta macro interagis avec chaques cellules de ta colonne, et je pense que c'est une des causes du ralentissement.
Ci joint un exemple de tableau avec ta macro :
- Dans un premier temps on recupere la totalité de tes valeurs, qu'on stocke dans un tableau.
- On execute ton code sur le tableau VBA, plus du tout sur la feuille
- A la fin du traitement, on colle le tableau
Sub Bouton1_Cliquer()
Dim a As String
Dim b As String
Dim c As String
Dim LiFin(2) As Long
Dim x As Long
Dim y As Long
Dim tabentree() As Variant
Dim lg As Long
LiFin(1) = Cells(Rows.Count, 2).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 6).End(xlUp).Row
'On dimensionne le tableau en fonction de la colonne la plus grande
If LiFin(1) >= LiFin(2) Then
lg = LiFin(1)
Else
lg = LiFin(2)
End If
'On recupere la totalité de tes valeurs, qu'on stocke dans un tableau
tabentree = ThisWorkbook.Sheets("feuil1").Range("A1:H" & lg).Value
'On execute ta macro sur le tableau
For x = 1 To LiFin(2)
c = c & "µ" & tabentree(x, 6)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = tabentree(x, 2)
If InStr(1, c, a) > 0 Then
tabentree(x, 8) = a
Else
tabentree(x, 8) = Mid(a, 1, 3)
End If
Next x
'On colle le tableau
ThisWorkbook.Sheets("feuil1").Range("A1:H" & lg).Value = tabentree
End Sub
Yann
Bonjour,
Testes ce code pour voir si il te convient :
Sub Bouton1_Cliquer()
Dim TblExep
Dim TblMots
Dim I As Long
Dim Exeption As String
With Worksheets("Feuil1"): TblMots = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With
With Worksheets("Feuil1"): TblExep = .Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp)): End With
For I = 1 To UBound(TblExep): Exeption = Exeption & TblExep(I, 1): Next I
For I = 1 To UBound(TblMots)
If InStr(Exeption, TblMots(I, 1)) = 0 Then TblMots(I, 1) = Left(TblMots(I, 1), 3)
Next I
Range(Cells(2, 8), Cells(UBound(TblMots) + 1, 8)) = TblMots
End Sub
Bonjour
Merci pour le code Thèse, il a l'air de moins perturber ma macro. Super
Cependant j'ai ce code ci dessous qui lui ralentit l'ouverture de ma feuille, je ne sais pas si on peut aussi remédier à ce problème ??
Il permet de reporter une date inscrite dans une cellule dans une autre cellule en fonction d'une date
[code]Private Sub Worksheet_Activate()
Dim derl As Long
' définir la dernière ligne en fonction de la Colonne A
derl = ActiveSheet.Cells(Application.Rows.Count, "A").End(xlUp).Row
' nouvelle version de la Copie
'Range("O3:X3").Copy Destination:=Range("O4:O" & derl)
'T 2018
Range("U39").FormulaArray = "=IFERROR(SMALL(IF(RC7:RC16-R35C7>0,RC7:RC16,""""),COLUMN(R2C[-20])),0)"
Range("U39").Copy Destination:=Range("V39:AD39")
Range("U39:AD39").Copy Destination:=Range("U40:U" & derl)
'T 2019
Range("AI39").FormulaArray = "=IFERROR(SMALL(IF(RC21:RC30-R35C8>0,RC21:RC30,""""),COLUMN(R2C[-34])),0)"
Range("AI39").Copy Destination:=Range("AJ39:AR39")
Range("AI39:AR39").Copy Destination:=Range("AI40:AI200")
'T 2020
Range("Aw39").FormulaArray = "=IFERROR(SMALL(IF(RC35:RC44-R35C9>0,RC35:RC44,""""),COLUMN(R2C[-48])),0)"
Range("AW39").Copy Destination:=Range("AX39:BF39")
Range("AW39:BF39").Copy Destination:=Range("AW40:AW200")
'T 2021
Range("BK39").FormulaArray = "=IFERROR(SMALL(IF(RC49:RC58-R35C10>0,RC49:RC58,""""),COLUMN(R2C[-62])),0)"
Range("BK39").Copy Destination:=Range("BL39:BT39")
Range("BK39:BT39").Copy Destination:=Range("BK40:BK200")
/code]
Bonjour,
Je ne me suis pas penché sur tes formules mais en bloquant le calcul automatique le code s'exécutera un peu plus vite, le calcul en mode automatique sera rétabli en fin de procédure :
Private Sub Worksheet_Activate()
Dim derl As Long
' définir la dernière ligne en fonction de la Colonne A
derl = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
' nouvelle version de la Copie
'Range("O3:X3").Copy Destination:=Range("O4:O" & derl)
'mets le calcul en manuel
Application.Calculation = xlCalculationManual
'T 2018
Range("U39").FormulaArray = "=IFERROR(SMALL(IF(RC7:RC16-R35C7>0,RC7:RC16,""""),COLUMN(R2C[-20])),0)"
Range("U39").Copy Destination:=Range("V39:AD39")
Range("U39:AD39").Copy Destination:=Range("U40:U" & derl)
'T 2019
Range("AI39").FormulaArray = "=IFERROR(SMALL(IF(RC21:RC30-R35C8>0,RC21:RC30,""""),COLUMN(R2C[-34])),0)"
Range("AI39").Copy Destination:=Range("AJ39:AR39")
Range("AI39:AR39").Copy Destination:=Range("AI40:AI200")
'T 2020
Range("Aw39").FormulaArray = "=IFERROR(SMALL(IF(RC35:RC44-R35C9>0,RC35:RC44,""""),COLUMN(R2C[-48])),0)"
Range("AW39").Copy Destination:=Range("AX39:BF39")
Range("AW39:BF39").Copy Destination:=Range("AW40:AW200")
'T 2021
Range("BK39").FormulaArray = "=IFERROR(SMALL(IF(RC49:RC58-R35C10>0,RC49:RC58,""""),COLUMN(R2C[-62])),0)"
Range("BK39").Copy Destination:=Range("BL39:BT39")
Range("BK39:BT39").Copy Destination:=Range("BK40:BK200")
'rétabli en automatique de cette façon, la feuille sera calculée en une seule fois et non à chaque insertion de formule
Application.Calculation = xlCalculationAutomatic
End Sub
Bonjour (...)
Je n'ai pas regardé du tout ce que fait ton code VBA mais je pense tout de même que le (vrai) problème c'est que tu fait exécuter à VBA ce qu'il y a de plus long à exécuter sur Excel.
A mon avis la dernière remarque "calcul en fin de traitement" devrait faire gagner du temps au code mais de toute façon tu le perd en formule matricielle qui sont de toute façon notoirement lentes...
Donc mon conseil serait si tu veux utiliser VBA, utilise VBA comme du VBA pas comme du Excel, tu verras il y a une très grande différence, et gain de temps énorme et véritable !
En conclusion VBA n'est pas fait pour faire du Excel. VBA est là pour faire ce que Excel ne sait pas faire !