将文本文件复制到Excel

Question

我必须将多个文本文件导入excel并将每个文本文件添加到新的工作表中。某些文件上的行数超过350,000。循环要花很长时间，以至于它不是真正的用户友好。我试图用它来快速读取数据

Dim arrLines() As String
Dim lineValue As String

lineValue = ts.ReadAll
DoEvents
arrLines() = Split(lineValue, vbCrLf)


Dim Destination As Range
Set Destination = Worksheets(WorksheetName).Range("A2")
Set Destination = Destination.Resize(UBound(arrLines), 1)
Destination.Value = Application.Transpose(arrLines)

但是，这导致行41243之后的每个值仅具有值“＃N / A”。我当时在考虑使用Application.Index将数组拆分成较小的数组，但是您需要给index函数一个要组成新数组的行数组，这意味着创建一个循环以遍历整个数组。数字1-41000，然后是41001-82000，依此类推。在这一点上，我正在做一个循环来创建数组，这并不是真的快。逐行循环通过文件同样太慢。在如此众多的行中进行读取而又不会丢失缺失值的好方法是什么？

Answer 1

您可以使用Excel的“数据”->“来自文本/ CSV”向导并使其自动化。

使用宏记录器最终会得到一个好的开始：

ActiveWorkbook.Queries.Add Name:="MyFile", Formula:="let" & Chr(13) & "" & Chr(10) & "    Source = Table.FromColumns({Lines.FromBinary(File.Contents(""C:\Path\MyFile.txt""), null, null, 1252)})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    Source"
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""MyFile"";Extended Properties=""""", Destination:=Range("$A$1")).QueryTable
    .CommandType = xlCmdSql
    .CommandText = Array("SELECT * FROM [MyFile]")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .ListObject.DisplayName = "MyFile"
    .Refresh BackgroundQuery:=False
End With

Answer 2

Mathieu Guindon正是我所希望的解决方案。消除移调已解决了＃N / A值的问题。谢谢！

编辑：

代码只是将数组中的数据第二次循环到二维数组中，然后将其发布到该范围内而没有转置效果。它比以前的方法要慢一些（大约需要两分钟或更长的时间），但是仍然相当快，并且可以产生我想要的结果。代码如下：

    lineValue = ts.ReadAll
DoEvents
arrLines() = Split(lineValue, vbCrLf)
Dim arrBetween() As Variant
ReDim arrBetween(UBound(arrLines), 0)

LoopLength = UBound(arrLines) - 1

For i = 0 To LoopLength
    arrBetween(i, 0) = arrLines(i)

    DoEvents

    If i Mod 2500 = 0 Or i = LoopLength Then
        Application.StatusBar = "Importing " & WorksheetName & " " & (i) & " ."
    End If
Next i

Dim Destination As Range
Set Destination = Worksheets(WorksheetName).Range("A2:A" & UBound(arrLines))

Destination.Value = arrBetween

Answer 3

将文本文件复制到Excel

向simple-solution表示建议（在注释中）使用Workbooks.Open打开文本文件。

代码

Sub CopyTextFilesToExcel()

    ' Search Folder Path
    Const cStrPath As String _
            = "D:\Excel\MyDocuments\StackOverflow\"
    Const cStrExt As String = "*.txt"       ' File Extension
    Const cFolderPicker As Boolean = False  ' True to enable FolderPicker

    Dim wb As Workbook          ' Current File
    Dim strPath As String       ' Path of Search Folder (Incl. "\" at the end.)
    Dim strFileName As String   ' Current File Name

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    On Error GoTo ProcedureExit

    ' Determine Search Path ("\" Issue)
    If cFolderPicker Then
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = False Then Exit Sub
            strPath = .SelectedItems(1) & "\"
        End With
      Else
        If Right(cStrPath, 1) <> "\" Then
            strPath = cStrPath & "\"
          Else
            strPath = cStrPath
        End If
    End If

    ' Determine first Current File Name.
    strFileName = Dir(strPath & cStrExt)

    With ThisWorkbook ' Target Workbook
        ' Loop through files in folder.
        Do While strFileName <> ""
            ' Create a reference to the Current File.
            Set wb = Workbooks.Open(cStrPath & strFileName)
            ' Copy first worksheet of Current File after the last sheet
            ' (.Sheets.Count) in Target Workbook.
            wb.Worksheets(1).Copy After:=.Worksheets(.Sheets.Count)
            ' Close Current File without saving changes (False).
            wb.Close False
            ' Find next File(name).
            strFileName = Dir()
        Loop
    End With

    MsgBox "All files copied!"

ProcedureExit:

  With Application
      .ScreenUpdating = True
      .DisplayAlerts = True
  End With

End Sub

将很大的数组读入Excel工作表的最佳方法

3 个答案:

将文本文件复制到Excel

代码