Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 09:26:26
Median für Zeilen mit gleichen Zeitstempel
19.04.2024 08:41:23
Zwei Makros in ein Arbeitsblatt - zweite wird nicht ausführt
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1256to1260
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1256to1260
1256to1260
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Textdateien per Marko importieren

Textdateien per Marko importieren
Tim
Hallo,
ich habe einen Ordner, in dem sich ausschließlich Textdateien befinden (neben der unten genannten Excel-Tabelle). Diese Textdateien enthalten jeweils lediglich eine Spalte Text (keine weiteren Einträge mit Trennzeichen o.ä.) + die gleiche Überschrift in der ersten Zeile zu Beginn.
Gibt es eine Möglichkeit, von der Excel-Tabelle, die sich im gleichen Ordner befindet auf diese Textdateien zuzugreifen und zwar so, dass dies automatisch beim Öffnen der Tabelle geschieht und mir idealerweise bei den folgenden Arbeitsschritten hilft ?
Im Forum habe ich so dazu noch nichts gefunden.
Meine (manuellen) Arbeitsschritte sind momentan:
1) Öffnen der einzelnen Textdateien.
2) Kopieren der Werte aus den Textdateien in die Excel-Tabelle, ohne die Überschriften in den Textdateien (Blatt 2, Spalte A).
3) Sortieren der Werte, alphabetisch aufsteigend
VG und vielen Dank Euch für jeden Tipp, Tim
AW: Textdateien per Marko importieren
10.04.2012 16:08:27
ChrisL
Hi Tim
So...
Sub MachListe()
Dim WS As Worksheet
Dim strPfad As String, strDateiName As String
Set WS = ThisWorkbook.Worksheets("Blatt2") ' Blatt Namen anpassen
WS.Columns(1).ClearContents ' optional, Spalte A leeren
WS.Range("A1") = "Titel" ' optional, Titel in A1 definieren
strPfad = ThisWorkbook.Path & "\*.txt"
strDateiName = Dir(strPfad)
Do
Call TextLesen(WS, strDateiName)
strDateiName = Dir
Loop Until strDateiName = ""
Columns("A:A").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub 
Private Sub TextLesen(WS As Worksheet, strDateiName As String)
Dim buffer As String, bErsteZeile As Boolean
bErsteZeile = True
Open strDateiName For Input As #1
Do While Not EOF(1)
Line Input #1, buffer
If bErsteZeile Then
bErsteZeile = False
Else
WS.Range("A65536").End(xlUp).Offset(1, 0) = buffer
End If
Loop
Close #1
End Sub

cu
Chris
Anzeige
AW: Textdateien per Marko importieren
10.04.2012 16:25:31
Tim
Hallo Chris,
das ist ja super - vielen vielen Dank dafür ! :-)
Noch ein paar Fragen zum Verständnis für mich als Anfänger:
1) MachListe habe ich jetzt in Blatt2 der Tabelle kopiert und TextLesen in ein Modul, ist das so richtig ?
2) Wenn ich möchte, dass das automatisch beim Öffnen der Excel-Tabelle abläuft, müsste ich es dann unter WorkbookOpen o.ä. erfassen ? Wie starte ich es ansonsten ?
VG und nochmals danke, Tim
AW: Textdateien per Marko importieren
10.04.2012 16:17:09
Rudi
Hallo, 
Sub Append_Txt()
Dim fso As Object, oFldr As Object, oFile As Object, arrTxt
Set fso = CreateObject("scripting.filesystemobject")
Set oFldr = fso.getfolder(ThisWorkbook.Path)
For Each oFile In oFldr.Files
If oFile.Name Like "*.txt" Then
arrTxt = GetTxt(oFile.Path)
Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(arrTxt)) = arrTxt
End If
Next
End Sub


Function GetTxt(oFile As String)
Dim sTxt, arrTxt(), i As Integer, arr
Open oFile For Input As #1
sTxt = Split(Input(LOF(1), 1), vbCrLf)
Close #1
ReDim arrTxt(1 To UBound(sTxt), 1 To 1)
For i = 1 To UBound(sTxt)
arrTxt(i, 1) = sTxt(i)
Next
GetTxt = arrTxt
End Function

Gruß
Rudi
Anzeige
AW: Textdateien per Marko importieren
10.04.2012 16:43:42
Tim
Hallo Rudi,
das ist genial - kurz, knackig und funktioniert perfekt ! :-)
Vielen Dank dafür !
Ich habe noch eine Frage dazu:
Kann man auch die Namen der jeweiligen Textdateien mit übernehmen, so dass diese in Spalte B angezeigt werden ?
Sorry, daran hatte ich anfangs nicht gedacht.
VG, Tim
AW: Textdateien per Marko importieren
10.04.2012 17:16:43
CitizenX
Hi,
Ich hab mal Rudis Code angepasst-geändert
so:
Option Explicit
Sub GetText()
  Dim fso As Object, oFldr As Object, oFile As Object, arrTxt
  Dim oStream As Object, lastRange As Range
  Set fso = CreateObject("scripting.filesystemobject")
  Set oFldr = fso.GetFolder(ThisWorkbook.Path)
  For Each oFile In oFldr.Files
    If oFile.Name Like "*.txt" Then
      Set oStream = fso.OpenTextFile(oFile.Path, 1)
        arrTxt = Application.Transpose(Split(oStream.ReadAll, vbCrLf))
        Set lastRange = Sheets(2).Cells(Rows.Count, 1).End(xlUp)
         With lastRange
            .Offset(1, 1) = oFile.Name
            .Offset(1).Resize(UBound(arrTxt), 1) = arrTxt
            .Offset(1).Resize(UBound(arrTxt), 1).Sort Key1:=lastRange
        End With
    End If
  Next
End Sub

wenns beim öffnen sein soll-dann ins wb open.
Grüße
Steffen
Anzeige
AW: Textdateien per Marko importieren
10.04.2012 17:28:09
Tim
Hallo Steffen,
vielen Dank !
Da passiert leider gar nichts. :-)
Muss ich da irgendetwas anpassen ?
VG, Tim
AW: Textdateien per Marko importieren
10.04.2012 17:36:23
CitizenX
Hi,
die Datei ist schon in deinem Ordner gespeichert ?
Wenn Rudi's Code lief sollte auch dieser laufen...
Grüße
Steffen
AW: Textdateien per Marko importieren
10.04.2012 17:42:59
Tim
Hallo Steffen,
Rudis Code funktioniert einwandfrei und sehr schnell. Verwende ich statt dessen Deinen Code passiert gar nichts. :-)
Die Datei befindet sich im Ordner mit den Textdateien und enthält momentan Rudis Code in Modul1 wie folgt: 
Function GetTxt(oFile As String)
Dim sTxt, arrTxt(), i As Integer, arr
Open oFile For Input As #1
sTxt = Split(Input(LOF(1), 1), vbCrLf)
Close #1
ReDim arrTxt(1 To UBound(sTxt), 1 To 1)
For i = 1 To UBound(sTxt)
arrTxt(i, 1) = sTxt(i)
Next
GetTxt = arrTxt
End Function


Sub Append_Txt()
Columns("A").ClearContents
Dim fso As Object, oFldr As Object, oFile As Object, arrTxt
Set fso = CreateObject("scripting.filesystemobject")
Set oFldr = fso.getfolder(ThisWorkbook.Path)
For Each oFile In oFldr.Files
If oFile.Name Like "*.txt" Then
arrTxt = GetTxt(oFile.Path)
Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(arrTxt)) = arrTxt
End If
Next
End Sub
VG, Tim
Anzeige
AW: Textdateien per Marko importieren
10.04.2012 17:52:33
CitizenX
Hi,
Hm.. kann ich immer noch nicht nachvollziehen
hier mal eine andere Variante:
Sub GetText()
  Dim fso As Object, oFldr As Object, oFile As Object, arrTxt
  Dim oStream As Object, lastRange As Range
  Set fso = CreateObject("scripting.filesystemobject")
  Set oFldr = fso.getfolder(ThisWorkbook.Path)
  Sheets(2).Cells(1, 1).CurrentRegion.Offset(1).Clear
  For Each oFile In oFldr.Files
    If oFile.Name Like "*.txt" Then
      Set oStream = fso.OpenTextFile(oFile.Path, 1)
        oStream.Skip 1
        arrTxt = Application.Transpose(Split(oStream.ReadAll, vbCrLf))
        Set lastRange = Sheets(2).Cells(Rows.Count, 1).End(xlUp)
         With lastRange
            .Offset(1, 1) = oFile.Name
            .Offset(1).Resize(UBound(arrTxt), 1) = arrTxt
            .Offset(1).Resize(UBound(arrTxt), 1).Sort Key1:=lastRange
        End With
    End If
  Next
End Sub
geändert wurde:
#1. Zeile der Text-Datei überspringen
#Bereich vor Neueingabe leeren
Grüße
Steffen
Anzeige
AW: Textdateien per Marko importieren
10.04.2012 18:32:36
Tim
Hallo Steffen,
vielen Dank nochmal.
Es klappt jetzt mit dem alten Code sehr gut - ich glaube, da haben sich unsere Emails überschnitten ?
Das einzige, was mir noch Probleme bereitet ist, dass der Name der Textdatei immer nur neben einem der Werte erscheint.
Hast Du vielleicht noch eine Idee, wie man den neben allen Werten der gleichen Textdatei anzeigen lassen kann ?
VG und vielen Dank für alle Hilfe, Tim
AW: Textdateien per Marko importieren
10.04.2012 18:47:26
CitizenX
Hi,
Option Explicit
Sub GetText()
  Dim fso As Object, oFldr As Object, oFile As Object, arrTxt
  Dim oStream As Object, lastRange As Range
  Set fso = CreateObject("scripting.filesystemobject")
  Set oFldr = fso.GetFolder(ThisWorkbook.Path)
  Sheets(2).Cells(1, 1).CurrentRegion.Offset(1).Clear
  For Each oFile In oFldr.Files
    If oFile.Name Like "*.txt" Then
        Set oStream = fso.OpenTextFile(oFile.Path, 1)
        oStream.Skip 1
        arrTxt = Application.Transpose(Split(oStream.ReadAll, vbCrLf))
        Set lastRange = Sheets(2).Cells(Rows.Count, 1).End(xlUp)
         With lastRange
            .Offset(1, 1).Resize(UBound(arrTxt) - 1, 1) = oFile.Name
            .Offset(1).Resize(UBound(arrTxt), 1) = arrTxt
            .Offset(1).Resize(UBound(arrTxt), 1).Sort Key1:=lastRange
        End With
    End If
  Next
End Sub

geändert wurde: 

.Offset(1, 1) = oFile.Name

in 

.Offset(1, 1).Resize(UBound(arrTxt) - 1, 1) = oFile.Name
Grüße
Steffen
Anzeige
AW: Textdateien per Marko importieren
10.04.2012 20:26:24
Tim
Hallo Steffen,
das klappt perfekt - vielen Dank für alles !!
Es läuft auch noch super-schnell ! :-)
VG und einen schönen Abend, Tim
AW: Fehler gefunden
10.04.2012 17:50:23
Tim
Hallo Steffen,
ich hab den Fehler (auf meiner Seite) gefunden - die Tastenkombi für das Makro hatte sich gelöscht.
Sorry - jetzt klappt es hervorragend, incl. Anzeige der Dateinamen. Super !
VG und vielen Dank nochmal - einen schönen Abend noch,
Tim
AW: Textdateien per Marko importieren
10.04.2012 22:53:04
Rudi
Hallo,
Antworten gab's ja jetz schon genug. Meine Version: 
Sub Append_Txt()
Dim fso As Object, oFldr As Object, oFile As Object, arrTxt
Set fso = CreateObject("scripting.filesystemobject")
Set oFldr = fso.getfolder(ThisWorkbook.Path)
For Each oFile In oFldr.Files
If oFile.Name Like "*.txt" Then
arrTxt = GetTxt(oFile.Path, oFile.Name)
Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(arrTxt), 2) =  _
arrTxt
End If
Next
End Sub

Function GetTxt(sFile As String, sName As String)
Dim sTxt, arrTxt(), i As Integer, arr
Open oFile For Input As #1
sTxt = Split(Input(LOF(1), 1), vbCrLf)
Close #1
ReDim arrTxt(1 To UBound(sTxt), 1 To 2)
For i = 1 To UBound(sTxt)
arrTxt(i, 1) = sTxt(i)
arrTxt(i, 2) = sName
Next
GetTxt = arrTxt
End Function

Gruß
Rudi
Anzeige
AW: Textdateien per Marko importieren
10.04.2012 22:59:45
Tim
Vielen Dank, Rudi - auch das ist wirklich klasse !! :-)
VG und einen schönen Abend Dir, Tim

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige