[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.

Rechercher des sujets similaires à "vba optimisation macro extraction donnees issues excels"