(CODE VBA) Une idée pour accélerer cette macro?

[Pygouv]

Bonjour j'utilise ce code ci dessous et je me demandais si quelqun pourrait le modifier afin que ma macro aille plus vite...
J'ai un document de 1400 lignes et une 40aine de colonnes et ma macro prend 45 minutes en temps d'execution

Merci beaucoup

Bonne soirée
Code :
Sub Bouton5_Clic()

Application.ScreenUpdating = False

Dim WS_Doublon As Worksheet
Set WS_Doublon = Worksheets("QV")

Dim fin_Doublon As Long
fin_Doublon = WS_Doublon.Range("A65536").End(xlUp).Row

Dim pcs_Doublon As Long
Dim val_colA As String
Dim val_colE As String

'On parcourt le tableau à l'inverse pour ne pas être géné par la suppression des lignes
For pcs_Doublon = fin_Doublon To 7 Step -1 '(le 1 est à remplacer par ta ligne de début)
val_colA = WS_Doublon.Cells(pcs_Doublon, 1).Value
val_colE = WS_Doublon.Cells(pcs_Doublon, 5).Value

'On teste les conditions
'On vérifie si le texte de la cellule en A CONTIENT "N", et si le texte de la cellule en E CONTIENT "Inventory Total Gross"
'/!\ Le texte testé peut être plus grand que le critère de recherche
If (val_colA Like "*N*") And (val_colE Like "*13 - INVENTORY -- Total Gross inventory (k€)*") Then
WS_Doublon.Rows(CStr(pcs_Doublon) & ":" & CStr(pcs_Doublon)).Delete shift:=xlUp
End If
Next pcs_Doublon
Application.ScreenUpdating = False

Sheets("Final extraction").Range("A2:F" & Rows.Count).ClearContents
ligne = 2
dercol = Sheets("QV").Cells(1, Columns.Count).End(xlToLeft).Column - 3
derlin = Sheets("QV").Cells(Rows.Count, 3).End(xlUp).Row
tablo = Sheets("QV").Range(Sheets("QV").Cells(1, 1), Sheets("QV").Cells(derlin, dercol))
For n = 3 To UBound(tablo, 1)
For m = 8 To UBound(tablo, 2)
If tablo(n, m) <> "" And tablo(n, m) <> "-" And tablo(n, m) <> 0 Then
Sheets("Final extraction").Cells(ligne, 1) = tablo(n, 4)
Sheets("Final extraction").Cells(ligne, 2) = tablo(n, 3)
Sheets("Final extraction").Cells(ligne, 3) = tablo(n, 5)
Sheets("Final extraction").Cells(ligne, 4) = tablo(2, m)
Sheets("Final extraction").Cells(ligne, 5) = tablo(1, m)
Sheets("Final extraction").Cells(ligne, 6) = tablo(n, m)
ligne = ligne + 1
End If
Next
ligne = ligne + 1
Next
Application.ScreenUpdating = False
Sheets("Final extraction").Select
MsgBox "Updated"

End Sub

 

[Dranreb]

Re : (CODE VBA) Une idée pour accélerer cette macro?

Oui, évidemment ! Où vouliez vous qu'il soit mis ailleurs ? Il n'y a que là qu'il existe une variable Ligne qui contient exactement la valeur qu'il faut.

 

[Pygouv]

Re : (CODE VBA) Une idée pour accélerer cette macro?

Ok super merci bcp!

 

[Pygouv]

Re : (CODE VBA) Une idée pour accélerer cette macro?

Auriez vous un code afin que la macro ne s'arrête pas à la ligne 500 mais poursuive jusqu'à la dernière ligne du tableau? Tout en sachant que le tableau viendra à être prolongé?

Merci d'avance

 

[Dranreb]

Re : (CODE VBA) Une idée pour accélerer cette macro?

Bonjour.
Le nombre de lignes pour que ça aboutisse à a dernière ligne du tableau est dans le variable Ligne.
Qu'est-ce que vous avez encore fichu ? Vous n'avez quand même pas copié avec l'instruction Ligne = 500 que j'avais été obligé de mettre dans ma petite macro de test pour qu'elle puisse tourner ? Ou alors c'est que vous n'avez rien compris ! Où plus exactement que vous n'avez jamais cherché à comprendre quoi que ce soit

 

[Pygouv]

Re : (CODE VBA) Une idée pour accélerer cette macro?

Comme je vous ai dit je débute, donc je ne fais pas exprès de ne pas comprendre et vous enquiquiner...

Ou est ce variable line? et à quoi correspond cette ligne = 500? Habituellement j'arrive à comprendre grâce aux testes d'explication en vert...

 

[Dranreb]

Re : (CODE VBA) Une idée pour accélerer cette macro?

Bonjour.
Fin de la procédure Bouton55_Clic:

With Worksheets("Final extraction").[A2:F2] ' Colonnes A:F, ligne 2 :
   .Resize(Rows.Count - 1, 7).ClearContents ' Effacement sur 7 colonnes de toutes les ligne à partir de là.
   .Resize(Ligne).Value = TabRés: End With ' Versement du tableau sur le nombre de lignes laissé à la fin de son remplissage.
With Worksheets("Final extraction").[G2].Resize(Ligne) ' Sur ce même nombre de lignes remplies, à partir de G2 :
   .FormulaR1C1 = "=DATE(RC5,(SEARCH(RC4,""janfebmaraprmayjunjulaugsepoctnovdec"")+2)/3,1)" ' Installation formule
   .NumberFormat = "mmm yyyy" ' Mise en place du format de date.
   End With
Application.ScreenUpdating = False
Sheets("Final extraction").Select
MsgBox "Updated"
End Sub

Et supprimez ce bouton et la procédure Bouton1_Clic() car ce n'était qu'un test de fonctionnement des instructions d'installation de la formule.