Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Daten auslesen/Zeit unterschiedliche Länge

Betrifft: Daten auslesen/Zeit unterschiedliche Länge von: Stamereilers
Geschrieben am: 05.07.2008 14:06:14

Hallo Excel Experten!
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) < (ZeilenLänge - 3) Then
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

  

Betrifft: AW: Daten auslesen von: ChristianM
Geschrieben am: 05.07.2008 20:20:09

Hallo Rolf,
hier ein Bsp.
Gruß
Christian

Option Explicit
Dim strFile As String
Dim lngPos As Long, lngR As Long


Sub AusTextDatei()
   strFile = Application.GetOpenFilename("TagRegEx.dat,*.dat")
   lngR = 3
   
   With ActiveSheet
      .Cells(1, 1) = 1
      .Range(.Cells(3, 3), .Cells(.Rows.Count, 3)).NumberFormat = "hh:mm:ss.000"
      .Range(.Cells(3, 4), .Cells(.Rows.Count, 4)).NumberFormat = "@"
   End With
   Call LeseAbPos
End Sub


Sub LeseAbPos()
   Dim intFile As Integer
   Dim strLine As String, varLine

   intFile = FreeFile
   With ActiveSheet
      If .Cells(1, 1) <> 1 Then Exit Sub
      Open strFile For Input As #intFile
         Seek #intFile, lngPos + 1
         Do Until lngPos >= LOF(intFile)
            Line Input #intFile, strLine
            varLine = Split(strLine, ";")
            .Cells(lngR, 4) = Trim(varLine(1))
            varLine = Split(varLine(0))
            .Cells(lngR, 1) = lngR - 2
            .Cells(lngR, 2) = CDate(varLine(0))
            .Cells(lngR, 3) = varLine(1)
            lngPos = lngPos + Len(strLine) + 2
            lngR = lngR + 1
         Loop
      Close #intFile

      Application.OnTime Now + TimeValue("00:00:05"), "LeseAbPos"
   End With
End Sub


Public Sub StopEinlesen()
   ActiveSheet.Cells(1, 1) = 0
End Sub




  

Betrifft: AW: Daten auslesen/Zeit unterschiedliche Länge von: Stamereilers
Geschrieben am: 06.07.2008 22:34:44

Hallo Christian!
Das Makro funktioniert super!

Danke!

Gruß

Rolf


 

Beiträge aus den Excel-Beispielen zum Thema "Daten auslesen/Zeit unterschiedliche Länge"