Question

我想显示文件夹和Excel中的7000个文件内容吗？

我找到了一段代码，它帮助了我，但它是唯一一本一读。但是，我想一次性阅读7000。请帮忙。

 Option Explicit
 Sub Import_TXT_File()
 Dim strg As Variant
 Dim EntireLine As String
 Dim FName As String
 Dim i As String

 Application.ScreenUpdating = False
 FName = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Choose File to Import")
 Open FName For Input Access Read As #1
 i = 1
 While Not EOF(1)
 Line Input #1, EntireLine
 strg = EntireLine
 'Change "Sheet1" to relevant Sheet Name
 'Change "A" to the relevant Column Name
 Sheets("Sheet1").Range("A" & i).Value = strg
 i = i + 1
 Wend
 EndMacro:
 On Error GoTo 0
 Application.ScreenUpdating = True
 Close #1
 End Sub

Answer 1

user1185158

当您阅读7000个文件时，您使用的代码将非常慢。此外，没有代码可以一次读取7000个文件。您将不得不遍历7000个文件。然而，有一个好消息:)您可以将整个文件读入数组，然后将其写入Excel，而不是循环遍历文本文件中的每一行。例如，与上面的代码相比，请查看此代码的速度非常快。

已经过测试

Sub Sample()
    Dim MyData As String, strData() As String

    Open "C:\MyFile.Txt" For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)
End Sub

现在在循环中使用相同的代码我们可以将其写入Excel文件

'~~> Change this to the relevant path
Const strPath As String = "C:\Temp\"

Sub Sample()
    Dim ws As Worksheet
    Dim MyData As String, strData() As String
    Dim WriteToRow As Long, i As Long
    Dim strCurrentTxtFile As String

    Set ws = Sheets("Sheet1")

    '~~> Start from Row 1
    WriteToRow = 1

    strCurrentTxtFile = Dir(strPath & "*.Txt")

    '~~> Looping through all text files in a folder
    Do While strCurrentTxtFile <> ""

        '~~> Open the file in 1 go to read it into an array
        Open strPath & strCurrentTxtFile For Binary As #1
        MyData = Space$(LOF(1))
        Get #1, , MyData
        Close #1

        strData() = Split(MyData, vbCrLf)

        '~~> Read from the array and write to Excel            
        For i = LBound(strData) To UBound(strData)
            ws.Range("A" & WriteToRow).Value = strData(i)
            WriteToRow = WriteToRow + 1
        Next i

        strCurrentTxtFile = Dir
    Loop

    MsgBox "Done"
End Sub

上面的代码所做的是它读取了表1中的7000个文本文件的内容（一个在另一个之下）。此外，我还没有包括错误处理。请这样做。

注意：如果您正在阅读繁重的文本文件，例如，每个文件有10000行，那么您将不得不调整上述方案中的代码，因为您将收到错误。例如

7000个文件* 10000行= 70000000行

Excel 2003有65536行，Excel 2007/2010有1048576行。

因此，一旦 WriteRow 达到最大行，您可能希望将文本文件内容读入工作表2，依此类推......

HTH

西特

Answer 2

进一步采取Siddharth的解决方案。您可能不希望一次写一行，在Excel中调用工作表的速度非常慢，最好在内存中进行任何循环并一次性回写：）

Sub Sample()
    Dim ws As Worksheet
    Dim MyData As String, strData() As String, strData2() As String
    Dim WriteToRow As Long, i As Long
    Dim strCurrentTxtFile As String

    Set ws = Sheets("Sheet1")

    '~~> Start from Row 1
    WriteToRow = 1

    strCurrentTxtFile = Dir(strPath & "*.Txt")

    '~~> Looping through all text files in a folder
    Do While strCurrentTxtFile <> ""

        '~~> Open the file in 1 go to read it into an array
        Open strPath & strCurrentTxtFile For Binary As #1
        MyData = Space$(LOF(1))
        Get #1, , MyData
        Close #1

        strData = Split(MyData, vbCrLf)

        'Resize and transpose 1d array to 2d
        ReDim strData2(1 To UBound(strData) + 1, 1 To 1)
        For i = 1 To UBound(strData)
            strData2(i, 1) = strData(i - 1)
        Next i

        Sheet1.Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Offset(1).Resize(UBound(strData), 1).Value = strData2

        strCurrentTxtFile = Dir
    Loop

    MsgBox "Done"
End Sub

读取文件夹中的所有文件并在Excel中显示内容

2 个答案: