(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

 

[Softmama]

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

Bonjour,

Oui, dans un post précédent, je t'avais prévenu que cette macro que tu utilises risquait d'être lente, je t'avais donné celui-ci à la place beaucoup plus rapide...

Reste à adapter pour ce que tu voulais y ajouter depuis ce moment...

Sub à_tester()
Dim Z As Range
Set Z = Range("IV1:IV" & Range("A65000").End(xlUp).Row)
Z.FormulaR1C1 = "=IF(ISERROR(FIND(""N"",RC1)*FIND(""13 - INVENTORY -- Total Gross inventory (k€)"",RC5)),"""",1)"
Z.Value = Z.Value
On Error Resume Next
Z.SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
Z.Clear
End Sub

 

[Pygouv]

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

Bosoir Softmama,

Merci mais ce n'est pas la macro de suppression de lignes qui pose problème...

C'est la seconde partie à propos du dispatch sur l'onglet de destination pour avoir une valeur par ligne qui dure très longtemps...

 

[Pygouv]

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

Je te joins le fichier si tu peux m'aider...

 

[Pygouv]

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

La macro postée précédement fonctionne bien mais est simplement trop longue

 

[Dranreb]

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

Bonsoir
Vous avez bien chargé en une fois la valeur de toute une plage dans une variable tablo
Pourquoi n'utiliseriez vous pas un second tableau que vous déchargeriez en une fois ?
À +

 

[Pygouv]

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

Bonjour,

Car ce code m'a été donné sur ce forum je l'ai juste appliqué à mon cas, et je débute en VBA donc je ne comprends pas tellement cette histoire de deuxièm tableau, si vous pouvez m'en dire plus je vous en serai très reconnaissant.

Merci

Bonne soirée

 

[Dranreb]

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

Votre code engage n*m*6 recherches dans la collection Sheets du classeur d'une feuille graphique ou d'une feuille de calcul portant le nom "Final extraction", y exécutant chaque fois un lourd repérage de localisation en mémoire d'une image de cellule pour y affecter une seule valeur à chaque fois. Pas étonnant que ce soit long ! Au lieu de ranger dans les cellules, rangez dans un tableau en mémoire, et videz celui ci sur toute la plage concernée en une fois, exactement par l'opération inverse de celle par laquelle vous avez chargé tablo.

 

[Pygouv]

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

Bonjour,

Mercipour votre réponse. je vous avoue être un peu perdu, auriez vous un fichier exemple s'il vous plaît? Je n'ai jamais créé de tablo...

 

[Dranreb]

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

Bonjour.
Re-joignez votre dernier classeur muni de la macro actuelle au format .xls s.v.p.
je n'ai même pas pris la peine d'ouvrir votre .xlsx car je sais qu'il ne peut pas contenir de macro.
À +

 

[Pygouv]

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

Bonjour voici le classeur en .xls

Merci beaucoup

 

[Dranreb]

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

Ben là j'ai "Impossible de reconnaitre le format du fichier" !
Enfin bref, ça pourrait être quelque chose comme ça :

Dim Tablo(), TabRés()
Tablo = Worksheets("QV").UsedRange.Value
ReDim TabRés(1 To UBound(Tablo, 1) * UBound(Tablo, 2), 1 To 6)
Ligne = 0
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
         Ligne = Ligne + 1
         TabRés(Ligne, 1) = Tablo(N, 4)
         TabRés(Ligne, 2) = Tablo(N, 3)
         TabRés(Ligne, 3) = Tablo(N, 5)
         TabRés(Ligne, 4) = Tablo(2, M)
         TabRés(Ligne, 5) = Tablo(1, M)
         TabRés(Ligne, 6) = Tablo(N, M)
         End If
      Next M
   Next N
With Worksheets("Final extraction").[A2:F2]
   .Resize(Rows.Count - 1).ClearContents
   .Resize(Ligne).Value = TabRés: End With

 

[Pygouv]

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

Merci, mais c'est encore trop long...

Quelqu'un éaurait il une solution afin d'accclérer tout ca?

Merci

 

[Dranreb]

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

Bonjour.

Ah non, cette partie de code ne peut pas être longue, même si elle est gênée par des calculs qui n'auraient pas été suspendus, le temps de l'exécution. À moins qu'elle ne provoque l'exécution d'une Worksheet_Change qui effectue des traitements longs parce que la prise en compte des évènement n'a pas été suspendue aussi. Ça doit être une autre parie du code qui traine. Joignez le tout que j'essaye de comprendre.

 

[Pygouv]

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

en xls? ou preferez vous une autre extension?

merci en tout cas