Импорт нескольких текстовых файлов Excel VBA

Question

Я хочу хранить данные в 1 листе из нескольких TXT-файлов. Кроме того, я хочу, чтобы первая ячейка содержала имя файла, а не путь к файлу (если это возможно), поэтому я могу связать его с графиками позже. В данных также есть столбцы AT MOST 7, в то время как число строк является переменным, а каждый дополнительный массив разделяется одним пустым столбцом.

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 

файлов .txt выглядит следующим образом: ... \ Сотрудники \ 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

Главного юг

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 

Helper югу

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 

Я бы предпочел не сильно использовать массивы, но reat, как массивы. Следовательно, вставка строки непосредственно в ActiveCell, а затем перемещение ActiveCell по одной строке ниже.

Я извлек код из одного из моих старых проектов, которые импортируют сотни тысяч строк в рабочий лист. Это завершается в течение минуты, поэтому все еще довольно быстро, хотя способ импорта каждой строки не является изящным.

Надеюсь, это поможет.