Voici le sixième billet de blog d’une série qui vise à approfondir un certain nombre de techniques qui permettent d’accélérer la transformation des données dans Excel VBA.
- Copier des cellules avec VBA
- Ajouter des données à un tableau
- Ouvrir un fichier et transférer des données vers le fichier cible
- Ouvrir une série de fichiers et transférer les données vers le fichier cible
- Sauvegarder des données dans un jeu d’enregistrements
- Lire les données de plusieurs fichiers avec un jeu d’enregistrements sans ouvrir les fichiers
- Réaliser un jeu d’enregistrement, sur la base des données de 2 feuilles de calcul différentes
Le précédent billet de blog nous a montré comment les données peuvent être sauvegardées dans un jeu d’enregistrements ou recordset. Dans ce blog, nous allons utiliser cette technique pour ouvrir tous les fichiers d’un dossier et transférer leurs données vers le fichier cible. Les connaissances nécessaires pour ouvrir un fichier peuvent être trouvées dans les blogs précédents de cette série.
Dans ce blog, nous comparerons également la méthode classique (workbooks.open) avec la méthode « recordset ».
Pour les besoins de cet exemple, j’utilise 20 fichiers identiques, contenant chacun 10 colonnes et 5 000 lignes de données. Le résultat est une feuille de travail avec 100K lignes et 10 colonnes. Tous les fichiers sont dans le même dossier.
Remarque: Nous allons travailler avec une liste classique pour cette solution et non avec un tableau. Pour copier des données dans un tableau, voir le blog 2 de cette série.
Dans un premier temps, vous préparez le code pour parcourir tous les fichiers d’un dossier. Les fichiers ne seront pas encore ouverts, seul leur nom sera mis dans notre variable. Vous reproduisez le nom de chaque fichier dans la ‘Debug Window’ (fenêtre de débogage) ou vous choisissez une ‘messagebox’ (boîte de dialogue de VBA). Si la boucle fonctionne, ajoutez le transfert de données dans le code.
Sub GetDataFromFiles()
Dim fldr As FileDialog
Dim strPath As String
Dim myFolder As String
Dim myFile As String
strPath = « C:\Xylos\BLOG\ » ‘ Dialog will start from this folder
Set fldr = Application.FileDialog(msoFileDialogFolderPicker) ‘ Select Folder, do not open folder
With fldr
.Title = « Select a Folder »
.AllowMultiSelect = False ‘ Select only 1 folder
.InitialFileName = strPath ‘ Folder location
If .Show <> -1 Then Exit Sub ‘ Quit when user cancels
myFolder = .SelectedItems(1)
End With
myFile = Dir(myFolder & « \*.xlsb »)
Do While myFile <> <> « »
Debug.Print myFile
myFile = Dir() ‘ Get Next File
Loop
End Sub
Hou er rekening mee dat het dialoogvenster dient om een folder aan te wijzen. Tenez compte du fait que la boîte de dialogue sert à désigner un dossier. Vous ne pouvez pas double-cliquer pour afficher le contenu du dossier. Indiquez le bon dossier et validez avec « OK ».
Astuce: avec l’exemple ci-dessus, le nom de chaque fichier présent dans le dossier est affiché dans la fenêtre immédiate (Immediate Window) par la commande ‘Debug.print’. Si la fenêtre n’est pas ouverte, vous pouvez la rendre visible avec le raccourci ‘CTRL+G’.
Vous pouvez maintenant ajouter le code qui ouvre chaque fichier à tour de rôle, copie les données et les transfère vers le fichier cible.
Il est préférable de commencer par la méthode classique où un fichier est ouvert, lu et fermé via l’objet ‘classeur’.
Voici le code adapté :
Sub GetDataFromFiles()
Dim fldr As FileDialog
Dim strPath As String
Dim myFolder As String
Dim myFile As String
Dim wbMain As Workbook
Dim wsMain As Worksheet
Dim wbData As Workbook
Dim wsData As Worksheet
Dim lngPasteRow As Long
strPath = « C:\Xylos\BLOG\ » ‘ Dialog will start from this folder
Set fldr = Application.FileDialog(msoFileDialogFolderPicker) ‘ Select Folder, do not open folder
With fldr
.Title = « Select a Folder »
.AllowMultiSelect = False ‘ Select only 1 folder
.InitialFileName = strPath ‘ Folder location
If .Show <> -1 Then Exit Sub ‘ Quit when user cancels
myFolder = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Debug.Print Now
myFile = Dir(myFolder & « \*.xlsb »)
Set wbMain = ActiveWorkbook
Set wsMain = ActiveSheet
lngPasteRow = 2
Do While myFile <> <> « »
Set wbData = Workbooks.Open(myFolder & « \ » & myFile)
Set wsData = wbData.Sheets(1)
wsData.Cells(1, 1).CurrentRegion.Copy wsMain.Cells(lngPasteRow, 1)
Set wsData = Nothing
wbData.Close False
lngPasteRow = wsMain.Cells(1, 1).End(xlDown).Row
myFile = Dir() ‘ Get Next File
Loop
Application.ScreenUpdating = True
Debug.Print Now
End Sub
Ce code est exécuté en 8 secondes environ. Sans utiliser la mise à jour d’écran (screenupdating) , il faut plus de temps pour ouvrir chaque fichier individuellement, ce qui fait clignoter l’écran.
Dans l’exemple suivant, nous utiliserons à nouveau des jeux d’enregistrements comme nous l’avons appris dans le blog précédent de cette série.
Sub GetDataFromFiles()
Dim fldr As FileDialog
Dim strPath As String
Dim myFolder As String
Dim myFile As String
Dim wbMain As Workbook
Dim wsMain As Worksheet
Dim wbData As Workbook
Dim wsData As Worksheet
Dim lngPasteRow As Long
‘ New variables
Dim myConnection As String
Dim RS As ADODB.Recordset
Dim mySQL As String
Application.ScreenUpdating = False
strPath = « C:\Xylos\BLOG\ » ‘ Dialog will start from this folder
Set fldr = Application.FileDialog(msoFileDialogFolderPicker) ‘ Select Folder, do not open folder
With fldr
.Title = « Select a Folder »
.AllowMultiSelect = False ‘ Select only 1 folder
.InitialFileName = strPath ‘ Folder location
If .Show <> -1 Then Exit Sub ‘ Quit when user cancels
myFolder = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Debug.Print Now
myFile = Dir(myFolder & « \*.xlsb »)
Set wbMain = ActiveWorkbook
Set wsMain = ActiveSheet
lngPasteRow = 2
Do While myFile <> <> « »
myConnection = « Provider=Microsoft.ACE.OLEDB.12.0; » & _
« Data Source= » & myFolder & « \ » & myFile & « ;Extended Properties=Excel 12.0 »
mySQL = « SELECT * FROM [Sheet1$] »
Set RS = New ADODB.Recordset
RS.Open mySQL, myConnection, adOpenForwardOnly, adLockOptimistic
wsMain.Cells(lngPasteRow, 1).CopyFromRecordset RS
RS.Close
Set RS = Nothing
lngPasteRow = wsMain.Cells(1, 1).End(xlDown).Row
myFile = Dir() ‘ Get Next File
Loop
Application.ScreenUpdating = True
Debug.Print Now
End Sub
Le temps d’exécution de ce code est désormais réduit à 4 secondes. La méthode autorise donc un gain de temps très intéressant lors de la lecture de toute une série de fichiers.
Prochain billet de blog : Réaliser un jeu d’enregistrements sur la base des données de 2 feuilles de calcul différentes (7/7).
Si vous avez contracté le virus « Excel » voire « Power BI » après avoir lu ce billet de blog , n’hésitez pas à consulter notre offre de formations ouvertes Excel. Qui sait, peut-être pourrions-nous bientôt nous rencontrer à Anvers ou à Bruxelles ?
