[VBA] Optimisation d'une macro - Extraction de données issues d'Excels
Bonjour à toutes et à tous,
Je débute depuis quelques mois sur VBA, et ce forum m'a été très utile, merci à ceux qui proposent leur aide !
Aujourd'hui à mon tour de vous demander un coup de main.
Je travaille sur un projet d'extraction de données, afin de les compiler dans un fichier excel récapitulatif unique.
Aujourd'hui, avec le peu de connaissances dont je dispose, j'ai une macro qui fonctionne, mais qui n'est absolument pas optimisée en terme de temps d’exécution. Je souhaites donc améliorer tout ça, maintenant que j'ai une base fonctionnelle.
Voici le fonctionnement global :
- A l'aide d'un userform, je sélectionne dans un premier temps 3 fichiers Excels différents qui contiennent les données que je souhaite rassembler dans un fichier de sortie récapitulatif unique.
- Je démarre l'extraction
- Les 3 fichiers s'ouvrent (ces derniers étant très volumineux, le démarrage de ces 3 derniers peut déjà prendre de 2 à 3 minutes)
- La macro procède à une sélection fichier source>sélection page source>sélection cellule source>copie
- Puis, la macro procède au collage de la donnée de la manière suivante : sélection fichier sortie>sélection page sortie>sélection cellule sortie>colle
D'un point de vue code ça donne ça :
'Extraire vitesse en km/h
Wbk_excel_source_1.Activate 'j'ai plusieurs fichiers excels source, je les définis plus tôt comme des workbook
Sheets("R1").Select 'je selectionne la page qui m'interesse
Range("F6").Select 'la cellule qui m'interesse
Selection.Copy 'la copie
Windows("Extraction.xlsm").Activate 'retourne sur mon excel de sortie
Sheets("Version1").Select 'selectionne la feuille de sortie
Cells(I, "G").Select 'selectionne la cellule de sortie, ici la variable I représente la premiere ligne vierge de mon excel de sortie
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'je ne copie que la valeur
'Extraire masse
Wbk_excel_source_2.Activate
Sheets("R3").Select
Range("N6").Select
Selection.Copy
Windows("Extraction.xlsm").Activate
Sheets("Version1").Select
Cells(I, "H").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Et je répète selon le même principe ce bout de code pour environ une centaine de cellules (un peu disgracieux comme manière de procéder), disposées sans réelle logique dans mes fichiers source (pas de disposition en colonne ou ligne, je pioche un peu partout)
Une extraction (une fois les fichiers sources ouverts) dure environ 1min30 à 2min.
A moins que je dise une bêtise, il devrait être possible de transformer ce bout de code en "fonction" ?
du style : fonction_extraction(cellule source, cellule sortie) ?
et en créant une fonction par fichier source et page source.
Si je parviens déjà à mettre en place ça, je pense que l’exécution sera raccourcie.
Dans un second temps j'ai vu qu'il était possible de procéder à une extraction sans ouverture des fichiers sources, mais j'ai du mal à cerner le fonctionnement..
En vous remerciant par avance !
Bonjour,
Tu fais la même erreur que la plupart des débutants : Activer et sélectionner avant d'agir.
C'est chronophage et totalement inutile.
Ton code se résume à 2 lignes :
'Extraire vitesse en km/h
Workbooks("Extraction.xlsm").Worksheets("Version1").Cells(I, "G").Value = _
Wbk_excel_source_1.Worksheets("R1").Range("F6").Value
'Extraire masse
Workbooks("Extraction.xlsm").Worksheets("Version1").Cells(I, "H").Value = _
Wbk_excel_source_2.Worksheets("R3").Range("N6").Value
ÉDIT : en utilisant des noms courts pour les variables, le code est plus lisible, par exemple :
Set wbkE = Workbooks("Extraction")
Set wbk1 = Workbooks.Open(Fichier1)
Set wbk2 = Workbooks.Open(Fichier2)
'Extraire vitesse en km/h
wbkE.Worksheets("Version1").Cells(I, "G").Value = wbk1.Worksheets("R1").Range("F6").Value
'Extraire masse
wbkE.Worksheets("Version1").Cells(I, "H").Value = wbk2.Worksheets("R3").Range("N6").Value
Merci beaucoup Patrice,
j'ai mis à jour toute ma macro ça fonctionne clairement beaucoup mieux.
Après avoir chronométré, je gagne environ 2min30 par extraction.
As-tu éventuellement une idée, pour obtenir le même résultat, sans avoir à ouvrir les fichiers sources Excels ?
Dans tous les cas merci beaucoup !
Re,
Tu peux adapter cette méthode à ton cas pour lire sans ouvrir le classeur :
Sub test()
Dim dossier$, fichier$, onglet$
dossier = "D:\Temp"
With ThisWorkbook.Worksheets(1)
.Cells.ClearContents
fichier = "Classeur à lire.xls"
onglet = "Feuil1"
Call LirePlageFermee(.Range("B5"), dossier, fichier, onglet, "$A$1:$F$10")
onglet = "HA"
Call LirePlageFermee(.Range("B16"), dossier, fichier, onglet, "$B$3:$H$8")
End With
End Sub
Sub LirePlageFermee(destination As Range, chemin$, classeur$, feuille$, plage$)
Dim f As String
' Redimensionner la destination selon la taille de la plage à lire
With Range(plage)
Set destination = destination.Resize(.Rows.Count, .Columns.Count)
End With
' Lire le fichier fermé
f = "='" & chemin & "\[" & classeur & "]" & feuille & "'!" & plage
With destination
.FormulaArray = f
.Value = .Value
End With
End Sub
C'est noté
Merci beaucoup.