Thema Datum  Von Nutzer Rating
Antwort
29.11.2012 16:26:18 mr. mike
NotSolved
29.11.2012 18:14:49 Lutz
NotSolved
29.11.2012 18:39:15 Lutz
NotSolved
29.11.2012 22:56:17 Gast41083
NotSolved
30.11.2012 09:16:08 Lutz
*****
Solved
30.11.2012 13:09:45 mr. mike
NotSolved
30.11.2012 13:36:35 mr. mike
NotSolved
Blau Daten aus mehreren txt-Dateien auslesen und jeweils in getrennte Tabellenblätter schreiben
30.11.2012 22:52:06 Lutz
*****
Solved

Ansicht des Beitrags:
Von:
Lutz
Datum:
30.11.2012 22:52:06
Views:
2226
Rating: Antwort:
 Nein
Thema:
Daten aus mehreren txt-Dateien auslesen und jeweils in getrennte Tabellenblätter schreiben

Hallo Mike,

der folgende Code überspringt sowohl leere Zeilen als auch leere Dateien, zudem erhalten die Tabellenblätter

den Namen der jeweiligen Datei

 

 Sub Import()
    Dim sh As Worksheet
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Dim fs, f, temp
    Dim noEntry As Boolean
    Set fs = CreateObject("Scripting.FileSystemObject")
    D = Dir("C:\VBA\Wolken\C*.txt")                          'Die auszulesenden Dateien fangen alle mit "C" an
    i = 1
    Do While D <> ""
        If i > Worksheets.Count Then Worksheets.Add after:=Worksheets(i - 1) 'Worksheet anfügen, wenn alle gefüllt sind
        Set sh = Worksheets(i) 'Nächstes Tabellenblatt auswählen
        sh.Cells.ClearContents 'Alle Einträge im Worksheet löschen
        X = 1
        noEntry = True
        Set f = fs.OpenTextFile("C:\VBA\Wolken\" & D, ForReading, TristateFalse)
        Do While f.AtEndOfStream <> True   'solange das Dateiende nicht erreicht ist
            temp = f.ReadLine                       'die nächste Zeile aus der Textdatei wird in die Variable temp abgelegt
            If IsLeer(temp) = False Then 'Zeile verarbeiten
                sh.Cells(X, 1) = Replace(temp, vbTab, ",")      'Tabulatoren in der Zeile werden durch Kommata ersetzt und in der Tabellenzelle Zeile x, Spalte A abelegt
                sh.Cells(X, 1).TextToColumns Destination:=sh.Cells(X, 1), Comma:=True 'Text in Spalten
                X = X + 1
                noEntry = False
            End If
        Loop
        sh.UsedRange.Columns.AutoFit 'Optimale Spaltenbreite setzen
        sh.Name = Replace(D, ".txt", "")
        D = Dir
        If noEntry = False Then i = i + 1
    Loop
End Sub
 
Public Function IsLeer(wert) As Boolean
    IsLeer = IsNull(wert) Or IsEmpty(wert) Or wert = ""
End Function
 
Gruß und ein schönes Wochenende
Lutz
 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen