Textdatei in Tabelle queer statt längs einlesen

Hi,
kann man in eine Excel Tabelle Daten auch nebeneinander anstatt untereinender einlesen ?
Habe folgendes Problem: meine Quellformat ist eine Textdatei und ist ungefähr so aufgebaut :
Zuerst kommt irgend ein Sonderzeichen, was bei Bedarf durch jedes andere Zeichen zu ersetzen wäre. Danach kommen die Datensätze, dann eine leere Zeile und dann wieder von vorne. Die Zeilen 1 - 105 gehören jeweils zu einem Datensatz (= 1 Zeile) :
%
Zeile1: xyz
Zeile2: zxy
Zeile3: yzx
:
:
Zeile105: xyz
%
Zeile1: xyz
Zeile2: zxy
Zeile3: yzx
:
:
Zeile105: xyz
%
Zeile1: xyz
Zeile2: zxy
Zeile3: yzx
:
:
Zeile105: xyz
usw. usw.
Kann man so eine Art von Textdatei irgend wie (per Excel-Funktion oder Makro) queer einlesen:
Zeile1: xyz Zeile2: zxy Zeile3: yzx ....... Zeile105: xyz
und dann wenn das Sonderzeichen kommt, dann wieder von vorne bei Spalte A mit dem nächsten Datensatz beginnt:
Zeile1: xyz Zeile2: zxy Zeile3: yzx ....... Zeile105: xyz
Zeile1: xyz Zeile2: zxy Zeile3: yzx ....... Zeile105: xyz
Zeile1: xyz Zeile2: zxy Zeile3: yzx ....... Zeile105: xyz
:
:
Vielleicht weiss jemand , wie das geht.
Danke mal
Joachim

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub LeseTXT() Dim Pfad As String 'damit es etwas schneller geht EventAusAn False 'Inhalt Zellen löschen Cells.ClearContents 'Pfad der Textdatei wo sich die Excelmappe befindet Pfad = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "") 'Textdatei Zeilenweise einlesen If Lese_TXT(Pfad & "Test.txt") = True Then EventAusAn MsgBox "Textdatei wurde gelesen", vbInformation Else EventAusAn MsgBox "Es sind Fehler aufgetreten!", vbCritical End If End Sub Function Lese_TXT(ByVal sFilename As String) As Boolean Dim F As Integer Dim sLine As String Dim A As Long, B As Long On Error GoTo Fehler: 'Fehler abfangen ' Existiert die Datei ? If Dir$(sFilename, vbNormal) "" Then F = FreeFile Open sFilename For Input As #F While Not EOF(F) Line Input #F, sLine If Trim$(sLine) = "%" Then A = A + 1: B = 1 GoTo NächsteZeile End If Cells(A, B).Value = Trim$(sLine) B = B + 1 NächsteZeile: Wend Close #F Else Lese_TXT = False End If Lese_TXT = True Exit Function Fehler: On Error Resume Next Close #F Lese_TXT = False End Function Sub EventAusAn(Optional Zustand As Boolean = True) Static ZustandAlt As Long If Zustand = False Then ZustandAlt = Application.Calculation With Application .EnableEvents = Zustand .ScreenUpdating = Zustand .Calculation = IIf(Zustand = True, ZustandAlt, xlCalculationManual) End With End Sub

Sub LeseTXT() Dim Pfad As String 'damit es etwas schneller geht EventAusAn False 'Inhalt Zellen löschen Cells.ClearContents 'Pfad der Textdatei wo sich die Excelmappe befindet Pfad = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "") 'Textdatei Zeilenweise einlesen If Lese_TXT(Pfad & "Test.txt", "Name1 Name2 Name3") = True Then EventAusAn MsgBox "Textdatei wurde gelesen", vbInformation Else EventAusAn MsgBox "Es sind Fehler aufgetreten!", vbCritical End If End Sub Function Lese_TXT(ByVal sFilename As String, strName As String) As Boolean Dim F As Integer Dim sLine As String Dim A As Long, B As Long Dim meinBlock As Boolean On Error GoTo Fehler: 'Fehler abfangen ' Existiert die Datei ? If Dir$(sFilename, vbNormal) "" Then F = FreeFile Open sFilename For Input As #F While Not EOF(F) Line Input #F, sLine If InStr(strName, Trim$(sLine)) > 0 Then meinBlock = True A = A + 1: B = 1 End If If Trim$(sLine) = "%" Then meinBlock = False If meinBlock = True Then Cells(A, B).Value = Trim$(sLine) B = B + 1 End If NächsteZeile: Wend goExit: Close #F Else Lese_TXT = False End If Lese_TXT = True Exit Function Fehler: On Error Resume Next Close #F Lese_TXT = False End Function Sub EventAusAn(Optional Zustand As Boolean = True) Static ZustandAlt As Long If Zustand = False Then ZustandAlt = Application.Calculation With Application .EnableEvents = Zustand .ScreenUpdating = Zustand .Calculation = IIf(Zustand = True, ZustandAlt, xlCalculationManual) End With End Sub

Hallo,
hier noch eine zweite Möglichkeit, sollte in Deiner Textdatei der Name auch in irgendeiner Form Bestandteil in den übrigen Texten sein funktioniert die 1. nicht.
Beispiel such Name = Joachim 1 so wird bei einer Zeile mit 1 dies als Name gefunden, dies wäre
ja falsch.
Option Explicit


Sub LeseTXT()
Dim Pfad As String
'damit es etwas schneller geht
EventAusAn False
'Inhalt Zellen löschen
Cells.ClearContents
'Pfad der Textdatei wo sich die Excelmappe befindet
Pfad = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "")
'Textdatei Zeilenweise einlesen
If Lese_TXT(Pfad & "Test.txt", "Tino Margit Marvin") = True Then
EventAusAn
MsgBox "Textdatei wurde gelesen", vbInformation
Else
EventAusAn
MsgBox "Es sind Fehler aufgetreten!", vbCritical
End If
End Sub


Function Lese_TXT(ByVal sFilename As String, strName As String) As Boolean
Dim F As Integer
Dim sLine As String
Dim A As Long, B As Long
Dim meinBlock As Boolean
Dim strSuch() As String
Dim lAnz As Long
On Error GoTo Fehler: 'Fehler abfangen
strSuch = Split(strName, " ")
' Existiert die Datei ?
If Dir$(sFilename, vbNormal)  "" Then
F = FreeFile
Open sFilename For Input As #F
While Not EOF(F)
Line Input #F, sLine
For lAnz = 0 To UBound(strSuch)
If strSuch(lAnz) = Trim$(sLine) Then
meinBlock = True
A = A + 1: B = 1
Exit For
End If
Next lAnz
If Trim$(sLine) = "%" Then meinBlock = False
If meinBlock = True Then
Cells(A, B).Value = Trim$(sLine)
B = B + 1
End If
NächsteZeile:
Wend
Close #F
Else
Lese_TXT = False
End If
Lese_TXT = True
Exit Function
Fehler:
On Error Resume Next
Close #F
Lese_TXT = False
End Function


Sub EventAusAn(Optional Zustand As Boolean = True)
Static ZustandAlt As Long
If Zustand = False Then ZustandAlt = Application.Calculation
With Application
.EnableEvents = Zustand
.ScreenUpdating = Zustand
.Calculation = IIf(Zustand = True, ZustandAlt, xlCalculationManual)
End With
End Sub

Gruß Tino

www.VBA-Excel.de

Beliebteste Forumthreads (12 Monate)

Textdatei in Tabelle queer statt längs einlesen

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Textdatei in Tabelle queer statt längs einlesen

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread