Lesen Sie alle Dateien im Ordner und zeigt die Inhalte in Excel

Möchte ich zeigen, 7000 Dateien Inhalte in einen Ordner und excel?

Habe ich eine gefunden, die ein Stück code, das hat mir geholfen, aber nur Lesen, eins nach dem anderen. Allerdings möchte ich zu Lesen, 7000 all in one gehen. Bitte helfen Sie. 

 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
InformationsquelleAutor Drozzy | 2012-03-01
  1. 6

    user1185158

    Dem code, die Sie verwenden, werden sehr langsam, wenn Sie das Lesen von 7000 Dateien. Es gibt auch keinen code Lesen kann 7000 Dateien in 1 gehen. Sie haben, um eine Schleife durch die 7000 Dateien. Es gibt jedoch eine gute Nachricht 🙂 Anstatt einer Schleife durch jede Zeile in der Textdatei, die Sie Lesen können, wird die gesamte Datei in ein array und dann schreiben Sie Sie in excel. Siehe zum Beispiel dieser code ist sehr schnell im Vergleich zu dem code, den Sie oben.

    AUSPROBIERT UND GETESTET

    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

    Nun mit dem gleichen code in einer Schleife können wir schreiben Sie in eine Excel-Datei

    '~~> 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

    Was der obige code macht, ist, dass es liest den Inhalt der 7000 text-Dateien in Blatt 1 (eins unter dem anderen). Auch ich habe nicht enthalten die Fehlerbehandlung. Bitte tun Sie das.

    VORSICHT: Wenn Sie beim Lesen schwere text-Dateien, sagen wir, jede Datei mit 10000 Zeilen, dann müssen Sie den code optimieren, in dem obigen Szenario erhalten Sie Fehler. zum Beispiel

    7000 Dateien * 10000 Zeilen = 70000000 Linien

    Excel 2003 hat 65536 Zeilen und Excel 2007/2010 hat 1048576 Zeilen.

    Also erst einmal die WriteRow erreicht die maximale Zeile, möchten Sie vielleicht Lesen Sie den text-Datei-Inhalte in Blatt 2 und so weiter...

    HTH

    Sid

    • Rout. Gibt es eine Möglichkeit, mit diesem Ansatz, ohne die Split? Meine Daten sind echte text und die Split unnötig zerlegt jedes Wort in Buchstaben, die zu schaffen wäre eine massive Anzahl von Spalten nach excel exportiert als solche (nehme ich an).
    • Ich habe versucht mit der Kombination von deiner und @Kyle 's code auf 31 txt-Dateien mit durchschnittlich 36 Zeilen pro Datei und es ist bereits mehr als 10 Minuten für etwas zu passieren (obwohl die Meldung "Done" erschien innerhalb von Nanosekunden...) muss Etwas falsch sein???
    InformationsquelleAutor Siddharth Rout
  2. 1

    Einnahme von Siddharth, der die Lösung ein wenig weiter. Sie wollen wahrscheinlich nicht zu schreiben, jede Zeile ein zu einer Zeit, Anrufe zu dem Arbeitsblatt sind extrem langsam in Excel, es ist besser zu tun, um jede Schleife in den Speicher und schreiben Sie zurück auf einen Streich 🙂

    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
    InformationsquelleAutor SWa
Schreibe einen Kommentar