Ich lese Daten aus einer Datenbank TagRegEx.dat aus.
Das klappte super! Dank eurer Hilfe.
Nun wurde die Länge der Zeit geändert, es können auch hunderstel und tausendestel erfaßt werden.
Die Zeit ist nun mal 11stellig oder 12stellig lang.
Das Problem ist die wechselde Länge der Zeit
Könnt ihr mir das unten Angegebene Makro ändern?
Es sollen 11 bzw. 12stellige Zeiten gelesen werden.
Ausschnitt aus Datenbank:
05.07.2008 13:41:14.395; AB4E0812000104E0
05.07.2008 13:41:19.653; 294E0812000104E0
05.07.2008 13:41:23.528; 264F0812000104E0
05.07.2008 13:41:27.384; A74F0812000104E0
05.07.2008 13:41:32.50; A74E0812000104E0
05.07.2008 13:41:37.989; 2A4F0812000104E0
05.07.2008 13:41:51.909; 27500812000104E0
05.07.2008 13:41:56.345; 23500812000104E0
05.07.2008 13:42:09.4; A2500812000104E0
05.07.2008 13:42:14.682; 24510812000104E0
05.07.2008 13:42:17.646; 20510812000104E0
05.07.2008 13:42:20.190; A4510812000104E0
05.07.2008 13:42:22.703; A0510812000104E0
05.07.2008 13:42:26.138; 23520812000104E0
05.07.2008 13:42:40.208; 1F520812000104E0
Makro:
Dim DateiPos As Long
Dim zeile As Integer
Dim datei As String
Option Explicit
Dim z As Double
Dim Startzeit As Date
Dim Uhrlaeuft As Boolean
Dim strMsg As String
Public NextTime As Date
Public Zeit1 As Date
Sub AusTextDatei()
DateiPos = 0
zeile = 0
datei = Application.GetOpenFilename("TagRegEx.dat,*.dat")
Cells(1, 1) = 1
LeseAbPos
End Sub
Sub LeseAbPos()
Dim Zeilenoffset As Integer
Dim strTxt As String
Dim FileLen As Long
If Cells(1, 1) 1 Then
Exit Sub
End If
Zeilenoffset = 2 'erste beiden Zeilen für die Überschriften
Open datei For Input As #1
Seek #1, DateiPos + 1
FileLen = LOF(1)
' Nur zur Information
'Cells(1, 2) = FileLen
'Cells(1, 3) = DateiPos
Do Until DateiPos >= FileLen
' in zeile wird die aktuelle Zeilennummer als
' globale Variable zwischen den Aufrufen gespeichert!
zeile = zeile + 1
' Zeile Einlesen
Line Input #1, strTxt
' Verarbeiten und das nächste mal nach den gelesenen Zeilen weiterlesen
' Hinter jeder Zeile folgen 2 Zeichen Zeilentrenner!
DateiPos = DateiPos + 2 + VerarbeiteZeile(strTxt, zeile + Zeilenoffset)
Loop
Cells(1, 4) = zeile
Close #1
'Uhrzeitspalte formatieren
Range(Cells(3, 3), Cells(ActiveSheet.Rows.Count, 3).End(xlUp)).NumberFormat _
= "hh:mm:ss.000"
'MsgBox "Habe die Daten ausgelesen!"
' wieder aufufen nach .. Sekunden
Application.OnTime Now + TimeValue("00:00:01"), "LeseAbPos"
End Sub
' Rückgabe: Länge der eingelesenen Zeile
Function VerarbeiteZeile(strZeile As String, intAktRow As Integer) As Integer
Dim iCol As Integer, iPosSemicolon As Integer
Dim ZeilenLänge As Integer
On Error GoTo Fehler
iCol = 1
' Erwartet wird ein Ausdruck, der von den Zeichenpositionen genau so aufgebaut ist:
' Länge einer Zeile muss 40 sein!!
ZeilenLänge = 41
VerarbeiteZeile = 0
Cells(intAktRow, iCol) = zeile
iCol = iCol + 1
If Len(strZeile) > ZeilenLänge Or Len(strZeile)
Cells(intAktRow, iCol) = "Fehler: " & strZeile
VerarbeiteZeile = Len(strZeile)
Exit Function
End If
iPosSemicolon = InStr(24, strZeile, ";")
'Datum auslesen
Cells(intAktRow, iCol) = CDate(Left(strZeile, 10))
'Uhrzeit auslesen, in Zahl umwandeln _
und 1000stel Sekunden ausschneiden, umwandeln und addieren
Cells(intAktRow, iCol + 1) = CDbl(CDate(Mid(strZeile, 12, 8))) _
+ CDbl(Mid(strZeile, 22, iPosSemicolon - 22)) / 1000 / 24 / 3600
'Text nach Semicolon einlesen
Cells(intAktRow, iCol + 2) = Mid(strZeile, iPosSemicolon + 2, 17)
MeineTöne
Fehler:
If Err.Number 0 Then
Cells(intAktRow, iCol) = "Fehler: " & strZeile
End If
VerarbeiteZeile = Len(strZeile)
End Function
Public Sub StopEinlesen()
Cells(1, 1) = 0
End Sub
Danke!
Gruß
Rolf