Importer un fichier texte multiple Excel VBA

Question

Je souhaite stocker des données dans une feuille de calcul à partir de plusieurs fichiers .txt. De plus, je veux que la première cellule contienne le nom du fichier et pas le chemin du fichier (si possible) afin que je puisse le lier plus tard aux graphiques. Il y a aussi AT MOST 7 colonnes dans les données alors que le nombre de lignes est variable et chaque tableau supplémentaire est séparé par une colonne vide.

Dim myFile As String 
Dim myValue As Integer 
Dim rData As Integer 
Dim Data As String 
Dim LineArray() As String 
Dim DataArray() As String 
Dim TempArray() As String 

Dim Delimiter As String 
Dim row As Integer 
Dim counter As Integer 
Dim counterArrSep As Integer 
Dim FileName As String 





Sub Button1_Click() 

'Input number of blades 
myValue = InputBox("Please enter the number of employees below", "number of employees", vbOKCancel) 

'Cancel (doesn't work properly) 
If myValue = 0 Then 
    Exit Sub 
End If 

'Inputs 
Delimiter = " " 
row = 1 

'Populate the table 
Do While counter < myValue 

'.txt file processing 

'Show open file dialog box 
myFile = Application.GetOpenFilename() 

'Cancel 
If myFile = "False" Then 
    Exit Sub 
End If 

'Get file name (doesn't work) 
FileName = Dir(myFile, vbDirectory) 
Dim DataArray() 
DataArray(counterArrSep, 0) = FileName 

'Open file 
rData = FreeFile 
Open myFile For Input As rData 

'Store file content inside a variable 
Data = Input(LOF(rData), rData) 

'Close file 
Close rData 

'Separate Out lines of data 
LineArray() = Split(Data, vbCrLf) 


'Read Data into an Array Variable 
For x = LBound(LineArray) To UBound(LineArray) 

    If Len(Trim(LineArray(x))) <> 0 Then 

    'Split up line of text by delimiter 
     TempArray = Split(LineArray(x), Delimiter) 

    'Determine how many columns are needed 
     col = UBound(TempArray) 

    'Re-Adjust Array boundaries 
    ReDim Preserve DataArray(col, row) 

    'Load line of data into Array variable 
     For y = LBound(TempArray) To UBound(TempArray) 
      DataArray(y + counterArrSep, row) = TempArray(y) 
    Next y 
End If 

'Next line 
    row = row + 1 

Next x 

'Clear array 
Erase TempArray 

'Increments the count to get another file 
counter = counter + 1 

'Adds space between each arrays in the Worksheet 
counterArrSep = counterArrSep + 8 

Loop 
End Sub 

Les fichiers txt ressemble à ceci: ... \ employés \ John.txt

apples pears oranges carrots 
4 5 34 2 
43 5,5 4 43 
6 54 9 7,5 
41,5 55 0 2 

...\employees\Steve.txt 
apples pears oranges carrots cabbages 
6 56 6 2 0 
4 1 4 12 5 
0 7 9 7 6 
0 12 1 5 3 
1 44 3 6 0 
4 4 4,5 6 23 

Answer 1

Sub Main

Public Sub Main() 
    Dim fd As FileDialog 
    Dim i As Long 

    Application.ScreenUpdating = False 

    'set and determine file picker behaviour 
    Set fd = Application.FileDialog(msoFileDialogFilePicker) 
    fd.AllowMultiSelect = True 

    'Launch file picker, exit if no files selected. Hold Ctrl to select multiple files. 
    If Not fd.Show = -1 Then Exit Sub 

    'Import selected files, file by file. 
    For i = 1 To fd.SelectedItems.Count 
     Call OpenFileForInput(fd.SelectedItems(i)) 
    Next i 
End Sub 

Aide sous

Private Sub OpenFileForInput(ByVal FilePathAndName As String) 
Dim DataInTransit As String 
Dim FileName  As String 
Dim rData   As Integer 
Dim Arr    As Variant 

'extract the filename 
FileName = StrReverse(Left(StrReverse(FilePathAndName), _ 
      InStr(1, StrReverse(FilePathAndName), "\") - 1)) 

rData = FreeFile 
Open FilePathAndName For Input As #rData 
    Do While Not EOF(rData) 
     Line Input #rData, DataInTransit 

     ' ################################################## 
     ' This is where the data gets into the worksheet, line by line for each file. 
     ' Modify to suit your needs 
      DataInTransit = FileName & " " & DataInTransit 
      Arr = Split(DataInTransit, " ") 
      ActiveCell.Resize(1, UBound(Arr) + 1) = Split(DataInTransit, " ") 
      ActiveCell.Offset(1).Activate 
     ' ################################################## 

    Loop 
Close #rData 
End Sub 

Je choisirais de ne pas utiliser beaucoup sur les tableaux, mais de t traitez la feuille de travail comme des tableaux. Par conséquent, collez la ligne directement dans ActiveCell, puis déplacez ActiveCell d'une ligne plus bas. J'ai extrait le code d'un de mes anciens projets qui importent des centaines de milliers de lignes dans la feuille de travail. Il se termine en une minute, donc il est toujours assez rapide, bien que la façon dont j'importe chaque ligne n'est pas élégante.

Espérons que cela aide.