Excel2010 - Datenblöcke aus Textfile in Spalten bzw. Zeilen vereinzeln

15/06/2010 - 08:28 von Erik Harren | Report spam
Juten Morjen!

Ich habe in einem Textfile mehrere Elemente, denen mehrere Messwertdaten
zugeordnet werden. Das Problem ist nun mehrteilig:

1. Die Anordnung der Messdaten:

IE2233
BU=aabbcc
123
234
...
345 <- bis zu 161 Messwerte, bis der nàchste Block beginnt
IE3456
BU=abc
111
...
5555 <- bis zu 161 Messwerte bis zum EOF

Die Gesamtzeilen können bis zu 256 dieser Elementblöcke betragen

2. Knapp neunzigtausend Dateien ggfs. in verschiedenen Verzeichnissen
nebst Unterverzeichnissen - hoffentlich vorsortiert.

Die Anordnug der Textfiles ist nachvollziehbar nicht sinnvoll für eine
Answertung. Der Kollege hàtte es eigentlich gerne in Spalten, jedoch
würde ich eher bei der Anzahl der Datenblöcke die Darstellungweise in
Zeilen bevorzugen. Meine Argumentation bzgl. der Anzahl der Elemente
überzeugt ihn wohl.

Nur - wie bekomme ich die Daten (wenigstens Verzeichnisweise) in die
gewünschte Form? Meine VBA-Kenntnisse beschrànken sich auf's lesen,
verstehen und ggfs. modifizieren von Code-Blöcken, für den Rest fehlt
mir die Phantasie.

Ich habe mein Anliegen zuletzt wohl nicht konkret genug beschrieben und
hoffe, es wird nun etwas deutlicher.

Gruß,
Erik.
 

Lesen sie die antworten

#1 Andreas Killer
15/06/2010 - 12:19 | Warnen spam
On 15 Jun., 08:28, Erik Harren wrote:

1. Die Anordnung der Messdaten:


Kein Ding, ist gut zu erkennen. Ich gehe mal davon aus das jedes
Zeilenende mit einem Standard-CrLf aufhört, falls nicht musst Du bei
Split nachbessern.

2. Knapp neunzigtausend Dateien ggfs. in verschiedenen Verzeichnissen
nebst Unterverzeichnissen - hoffentlich vorsortiert.


Dann lohnt es sich mal tiefer in die Trickkiste zu greifen.

Die Anordnug der Textfiles ist nachvollziehbar nicht sinnvoll für eine
Answertung. Der Kollege hàtte es eigentlich gerne in Spalten, jedoch
würde ich eher bei der Anzahl der Datenblöcke die Darstellungweise in
Zeilen bevorzugen. Meine Argumentation bzgl. der Anzahl der Elemente
überzeugt ihn wohl.


Naja, kann man so und so sehen, ich berücksichtige mal beide
Möglichkeiten.

Nur - wie bekomme ich die Daten (wenigstens Verzeichnisweise) in die
gewünschte Form? Meine VBA-Kenntnisse beschrànken sich auf's lesen,


Um die Verzeichnisse zu lesen würde ich auf das FileSearch-Object
zurückgreifen, das hat eine SearchSubFolders-Eigenschaft die Dir den
Kàse mit den Unterverzeichnissen abnimmt. Außerdem kannst Du die
Dateien auch gleich sortieren lassen, z.B. nach dem Dateidatum. Kuck
mal in die Hilfe, ist ein gutes Beispiel drin.

Falls Du zu den "Glücklichen" gehörst die mit XL2007 oder spàter
arbeiten müssen, dann nochmal melden, das Teil wurde von MS ersatzlos
gestrichen, hab ich mir für sollche Fàlle nachgebaut.

Probier erst mal eine Datei in das aktuelle Blatt einzulesen, mehrere
Dateien in das gleiche Blatt geht mit einer einfachen Modifiaktion
auch, falls nötig.

Wenn das geht, dann mach ein Test mit einem kleinen Verzeichnis und
überleg Dir wie die Daten in die Tabellen aufzuteilen sind.

Andreas.

Option Explicit
Option Base 0

Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal _
nCount As Long)
Private Declare Sub ZeroMemory Lib "kernel32" Alias _
"RtlZeroMemory" (Destination As Any, ByVal Length As Long)

Sub Test()
DateiEinlesen "C:\temp\test.txt"
End Sub

Private Sub DateiEinlesen(ByVal DateiName As String, _
Optional InSpalten As Boolean = False, _
Optional Tabelle As Worksheet = Nothing)
'Lies die Daten in eine Tabelle ein, trennt Datenblöcke

Dim FSO As Object 'FileSystemObject
Dim Datei As Object 'TextStream
Dim Inhalt As String
Dim Zeilen() As String, Data() As String
Dim I As Long, J As Long, Start As Long
Dim Antwort As VbMsgBoxResult

'Wenn mehrere Dateien in das gleiche Blatt eingelesen werden _
sollen, dann sind diese beiden Zàhler in den Deklarationsteil _
des Moduls zu verschieben und bei einem Wechsel des Blattes _
sowie Neustart auf 0 zu setzen:
Dim Zeile As Long, Spalte As Long

On Error GoTo FileError
Set FSO = CreateObject("Scripting.FileSystemObject")
'Datei öffnen
Set Datei = FSO.OpenTextFile(DateiName)
'Alles einlesen
Inhalt = Datei.ReadAll
'Datei zu
Datei.Close
'Zeilen trennen
Zeilen = Split(Inhalt, vbCrLf)
On Error GoTo 0

'Ggf. aktuelle Tabelle setzen
If Tabelle Is Nothing Then Set Tabelle = ActiveSheet

'Bildschirm aus
Application.ScreenUpdating = False
'Durchlaufe alle Zeilen
For I = 0 To UBound(Zeilen)
'IE markiert die Trennstellen der Datenblöcke
If StrComp(Left$(Zeilen(I), 3), "IE=", vbTextCompare) = 0 _
Then
GoSub SpeicherDaten
End If
Next
'Ggf. letzten Datenblock speichern
GoSub SpeicherDaten
'Bildschirm ein
Application.ScreenUpdating = True
Exit Sub

SpeicherDaten:
'Daten vorhanden?
If I > Start Then
If InSpalten Then
'Platz für Datenblock dimensionieren
ReDim Data(Start To I - 1, 0 To 0) As String
'Stringpointer verschieben
CopyMemory ByVal VarPtr(Data(Start, 0)), ByVal VarPtr( _
Zeilen(Start)), (I - Start) * 4
ZeroMemory ByVal VarPtr(Zeilen(Start)), (I - Start) * 4

'Nàchste Spalte berechnen
Spalte = Spalte + 1
If Spalte > Columns.Count Then
MsgBox "Nicht genügend Spalten für Daten! Abbruch!"
Exit Sub
End If

'Anzahl Zeilen prüfen
If UBound(Data) - LBound(Data) + 1 > Rows.Count Then
Antwort = MsgBox("Datenblock zu lang! Übergehen?", _
vbOKCancel)
If Antwort = vbCancel Then
Exit Sub
Else
'Spalte zurücksetzen
Spalte = Spalte - 1
GoTo SavePos
End If
End If

'In Tabelle schreiben
Tabelle.Cells(1, Spalte).Resize(UBound(Data) - LBound( _
Data) + 1) = Data
Else
'Platz für Datenblock dimensionieren
ReDim Data(Start To I - 1) As String
'Stringpointer verschieben
CopyMemory ByVal VarPtr(Data(Start)), ByVal VarPtr( _
Zeilen(Start)), (I - Start) * 4
ZeroMemory ByVal VarPtr(Zeilen(Start)), (I - Start) * 4

'Nàchste Zeile berechnen
Zeile = Zeile + 1
If Zeile > Rows.Count Then
MsgBox "Nicht genügend Zeilen für Daten! Abbruch!"
Exit Sub
End If

'Anzahl Spalten prüfen
If UBound(Data) - LBound(Data) + 1 > Columns.Count Then
Antwort = MsgBox("Datenblock zu lang! Übergehen?", _
vbOKCancel)
If Antwort = vbCancel Then
Exit Sub
Else
'Spalte zurücksetzen
Zeile = Zeile - 1
GoTo SavePos
End If
End If

'In Tabelle schreiben
Tabelle.Cells(Zeile, 1).Resize(1, UBound(Data) - LBound( _
Data) + 1) = Data
End If
SavePos:
'Position merken
Start = I
End If
Return

FileError:
MsgBox DateiName & vbCrLf & "Fehler " & Err.Number & ": " & _
vbCrLf & Err.Description
End Sub

Ähnliche fragen