导入多个文本文件 Excel VBA

Posted 2023-05-09

【中文标题】导入多个文本文件 Excel VBA

【英文标题】：Import multiple text file Excel VBA

【发布时间】：2015-11-24 13:07:02

【问题描述】：

我想将来自多个 .txt 文件的数据存储在 1 个工作表中。另外，我希望第一个单元格包含文件名而不是文件路径（如果可能），以便稍后将其链接到图表。数据中还有最多 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 文件如下所示： ...\employees\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

【问题讨论】：

那么到底是什么问题？您应该将代码拆分为几个过程。制作一个获取所选文件夹中所有文件的文件。然后让另一个文件同时导入一个文件，并通过将文件名作为参数传递来从第一个文件调用第二个过程。现在我猜你在浏览文件时遇到了问题，对吧？

顺便说一句：你真的应该更好地构建你的代码。例如，在过程之外声明整个模块的所有变量是没有意义的。将您的问题分解为更多更小的问题并一一解决。目前你离解决方案真的很远，你有很多问题。确定您的项目结构并在确定一个问题后返回。

对不起 VBA 几年前。我试着把我记得的东西放在一起。

【参考方案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

辅助子

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

我会选择不在数组上大量使用，而是将工作表范围视为数组。因此将该行直接粘贴到 ActiveCell 中，然后将 ActiveCell 移动到下一行。

我从我的一个旧项目中提取了代码，该项目将数十万行导入到工作表中。它在一分钟内完成，因此仍然相当快，尽管我导入每一行的方式并不优雅。

希望这会有所帮助。

【讨论】：

太棒了！谢谢，我想我可以和其他人一起工作:)。我讨厌我以前的 VBA 老师从来不允许我们在 VBA 中使用 Excel 函数。

不用担心。现在你可以享受所有的乐趣了！享受！！ :)

你知道如何转置数据吗？我试过了，结果有些不愉快。

是的……你试过WorksheetFunction.Transpose()吗？也许将其作为单独的问题发布会得到更多建议..