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

P

Pygouv

XLDnaute Occasionnel
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
 
Trier par date Trier par votes
P

Pygouv

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

Encore une petite question, à la suite de l'extraction réussie, que je souhaite utilisé comme source de mon outil, je la transforme en tableau.

Puis je crée un graphique dynamique sur l'onglet "feuil 1" mais les mois (qui sont en colonne) ne se rangent pas par ordre de dates mais uniquement par ordre alphabetique : apr, aug, ... et je souhaiterai avoir Jan, Feb, Mar en premier dans mon graph...

Quelqu'un a une solution?

Je joins mon fichier en .xls

je souhaite un graph pour l'année 2012, l'activité des bars, et en Europe (U/O)
 

Pièces jointes

  • Problème VBA ordre alphabetique.xls
    261 KB · Affichages: 33
  • Problème VBA ordre alphabetique.xls
    261 KB · Affichages: 34
  • Problème VBA ordre alphabetique.xls
    261 KB · Affichages: 37
Vote positif 0 Vote négatif
Dranreb

Dranreb

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

Il vaut mieux mettre des dates de début de mois que des noms de mois dans des colonnes séparées.
Cela dit cette formule en D2, à propager vers le bas en donne sur les mois qui coïncident au français chez moi:
Code: 
=DATEVAL("1 "&$D2&" "&$E2)
Alors vous pouvez classer dessus. Essayez aussi:
VB: 
Worksheets("Final extraction").[G2].Resize(Ligne).FormulaR1C1 = "=DATEVALUE(""1 ""&RC4&"" ""&RC5)"
N'incrémentez plus Ligne à la fin ça ne sert à rien. Pourquoi ne programmez vous pas aussi le classement derrière ?
 
Vote positif 0 Vote négatif
P

Pygouv

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

Merci pour votre réponse.

Que voulez vous dire pour programmer le classement derrière?

Merci j'essaye votre code tout de suite. Le soucis est que ces noms donnés au mois : jan, feb, etc sont issus d'un extraction d'un logiciel, donc je ne peux les modifier manuellement au début.
 
Vote positif 0 Vote négatif
P

Pygouv

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

Je n'arrive pas à faire fonctionner la formule et le code, pouvez vous l'appliquer à mon fichier joint envoyé plus haut?

Je dois utilisé cette extraction afin de créer de multiple TCDs pour ensuite utiliser les graphiques dynamiques pour ensuite faire mes analyses. Donc je suppose qu'il faut que mes mois sous forme anglaise (Jan, Feb, etc...) doivent être modifiés dans l'onglet "final extraction" afin que le TCD les considère comme une date...
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

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

Bonjour.
Alors s'ils ne passe pas non plus chez vous en français il faut plutôt :
VB: 
Worksheets("Final extraction").[G2].Resize(Ligne).FormulaR1C1 = "=DATE(RC5,(SEARCH(RC4,""janfebmaraprmayjunjulaugsepoctnovdec"")+2)/3,1)"
Ah oui, non, je voulais dire baser le TCD sur cette colonne G alors. Avec un format qui ne restitue que le nom du mois.
 
Vote positif 0 Vote négatif
P

Pygouv

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

J'ai finalement réussi sans code, j'ai déplacé manuellement les colonnes de mon TCD... et cela fonctionne cela reste en place quand je change mon extraction.

Autre petite question...

Dans mon extraction j'ai une colonne mois en D (jan,feb,mar...)et une colonne Année en E (2010 2011 2012 2013)

Je souhaiterai avoir dans la colonne D par ex : "Jan 12" SI la cellule sur la même ligne en colonne E contient 2012... Idem pour Feb 12, Aug 10, Sep 11, apr 13...

J'ai pensé a concatener mais il me faut conserver ma colonne Year intacte pour l'utiliser en filtres de mes futures TCDs...

Le problème posé en fait est que lorsque je choisis 2012 et 2011 en filtre d'un TCD, comme les mois ont tous les mêmes noms quils soient de 2011 ou 2012 ils s'additionnent et donc mon outil n'est que utilisable pour un an...

Si quelqu'un a une formule ou code VBA, car cela m'a l'aire impossible avec une RECHV ou fonction SI...
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

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

Où est le problème ? Quand vous aurez réussi il ne vous restera plus qu'à mettre sur cette colonne le format de date qui vous convient.
C'est à mettre évidemment derrière le bloc With - End With

En tout cas chez moi j'ai testé cette petite procédure, elle fonctionne parfaitement sur votre classeur:
VB: 
Sub Macro1()
Dim Ligne As Long
Ligne = 500
With Worksheets("Final extraction").[G2].Resize(Ligne)
   .FormulaR1C1 = "=DATE(RC5,(SEARCH(RC4,""janfebmaraprmayjunjulaugsepoctnovdec"")+2)/3,1)"
   .NumberFormat = "mmm yyyy"
   End With
End Sub
Elle met bien cette formule à partir de G2:
Code: 
=DATE($E2;(CHERCHE($D2;"janfebmaraprmayjunjulaugsepoctnovdec")+2)/3;1)
 
Dernière édition:
Vote positif 0 Vote négatif
P

Pygouv

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

Bonjour , oui merci cela marche parfaitement, mais le problème est que mon TCD reste classé en ordre alphabétique... et non pas en ordre des mois, donc mes graphiques n'ont aucun sens... :(
Autre soucis avec votre code les mois apparaissent en français... je les souhaieterai en anglais. J'ai concatené en colonne en colonne G, je vous joins le fichier...
 

Pièces jointes

  • Problème VBA ordre alphabetique.xls
    236 KB · Affichages: 35
  • Problème VBA ordre alphabetique.xls
    236 KB · Affichages: 34
  • Problème VBA ordre alphabetique.xls
    236 KB · Affichages: 38
Vote positif 0 Vote négatif
Dranreb

Dranreb

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

Bonjour.
Vous n'avez pas mis ce code dans la Sub Bouton55_Clic à la place de cetrte incrémentation finale de Ligne qui ne sert à rien.
Et le TCD est toujours basé sur ces stupides textes de mois anglais et non sur des dates correctes reconstituées à l'aide de ma formule.
 
Vote positif 0 Vote négatif
P

Pygouv

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

Arf mon message précédent n'est pas parti...

Votre code marche parfaitement je vous remercie et donc les TCDs sont dans l'ordre adequate.

Je ne comprends pas cette histoire d'incrementation...

De quoi voulez vous parler? Auriez vous un screenshot? merci
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

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

Il y a ça, à la fin de votre Module1:
sans titre1.jpg
ce stupide Ligne = Ligne + 1 qui ne sert à rien au lieu du code qui implante la formule restituant une date correcte.
 

Pièces jointes

  • sans titre1.jpg
    sans titre1.jpg
    10 KB · Affichages: 56
  • sans titre1.jpg
    sans titre1.jpg
    10 KB · Affichages: 55
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
111
marie3107
M
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
169
marie3107
M
A
  • Question
Insérer un copier / coller
Réponses
0
Affichages
190
aziz
A
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
162
rebatte
R
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
84
Latias
L
A
  • Résolu(e)
XL 2019 Passage de 2013 pro à 2019 pro, Pb avec formule VBA, liens hypertexte
2 3 4
Réponses
54
Affichages
2 K
sylvanu
sylvanu
M
  • Question
XL 2019 Optimisation de code VBA
2 3
Réponses
33
Affichages
2 K
mmaiga
M
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
573
Vermithor
V
R
  • Question
XL 2021 Optimisation Code VBA
Réponses
10
Affichages
385
Dranreb
Dranreb
A
  • Résolu(e)
Microsoft 365 Correction du code vba
Réponses
5
Affichages
197
AD95
A

Membres actuellement en ligne

15 membres et 106 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 322
Messages
2 087 284
Membres
103 507
dernier inscrit
tapis23