Uhrzeit beim extrahieren verfälscht
17.01.2018 11:57:44
Burak
also es geht um die Uhrzeit. Wenn ich das Datum und die Uhrzeit aus einer Zelle in zwei aufteile, verfälscht er die Uhrzeit unter gewissen Umständen.
Die Zelle die das Datum UND die Uhrzeit enthält ist als Standard formatiert und beinhaltet Werte wie:
20181101212256, also yyyymmddhhmmss was dann 01.11.2018 und 21:22:56 Uhr wäre.
Bei Werten, wo die Uhrzeit mit 0 beginnt, werden die Uhrzeiten verfälscht bzw. die 0 vorne weggelassen.
also ...011705 wird zu 11:70:05 statt 01:17:05
...003748 wird zu 37:48:48 statt 00:37:48
und ...000818 wird zu 81:8:18 statt 00:08:18
Die Beispieldatei (Ausschnitt):
https://www.herber.de/bbs/user/119035.xlsm
und der Code:
Sub Logimport()
'Deklarationen der Variablen
Dim k As Long
Dim ws As Worksheet
Dim importdatei As String
Dim Zeilenzahl As Long
'Auswahl der Log-Datei für den Import
importdatei = Application.GetOpenFilename
Do Until importdatei "Falsch"
importdatei = Application.GetOpenFilename
Loop
'Tabellenblatt leeren
Worksheets("LogImport").Cells.Clear
'Import der Log-File
Set ws = ActiveWorkbook.Sheets("LogImport")
With ws.QueryTables.Add(Connection:="TEXT;" & importdatei, Destination:=ws.Range("A2"))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
With Worksheets("LogImport")
'Anzahl der beschrifteten Zeilen zählen
Zeilenzahl = .Cells(.Rows.Count, 2).End(xlUp).Row
'Spalten hinzufügen
.Columns("A:A").Insert Shift:=xlToRight
.Columns("J:K").Insert Shift:=xlToRight
.Columns("M:N").Insert Shift:=xlToRight
'Textformatierung von Spalten
For k = 2 To Zeilenzahl
.Range("A" & k).Value = Left(.Range("B" & k).Value, 4) ' _
Erste 4 Stellen des Masterbarcodes
If .Range("O" & k).Value 0 Then
.Range("F" & k).Value = .Range("F" & k).Value & "-" & .Range("O" & k).Value ' _
Analyse-Typ Zusammensetzung
End If
.Range("J" & k).Value = Left(.Range("I" & k).Value, 8) ' _
AOI-Eintrag Datum
.Range("K" & k).Value = Right(.Range("I" & k).Value, 6) ' _
AOI-Eintrag Uhrzeit
.Range("M" & k).Value = Left(.Range("L" & k).Value, 8) ' _
Reparatureneintrag Datum
.Range("N" & k).Value = Right(.Range("L" & k).Value, 6) ' _
Reparatureneintrag Uhrzeit
.Range("J" & k).Value = Right(.Range("J" & k).Value, 2) & "." & Mid(.Range("J" & k).Value, _
5, 2) & "." & Left(.Range("J" & k).Value, 4)
.Range("K" & k).Value = "'" & Left(.Range("K" & k).Value, 2) & ":" & Mid(.Range("K" & k). _
Value, 3, 2) & ":" & Right(.Range("K" & k).Value, 2)
.Range("M" & k).Value = Right(.Range("M" & k).Value, 2) & "." & Mid(.Range("M" & k).Value, _
5, 2) & "." & Left(.Range("M" & k).Value, 4)
.Range("N" & k).Value = "'" & Left(.Range("N" & k).Value, 2) & ":" & Mid(.Range("N" & k). _
Value, 3, 2) & ":" & Right(.Range("N" & k).Value, 2)
.Range("O" & k).Value = Right(.Range("C" & k).Value, 1) ' _
Rausfiltern der LP aus dem BT-Namen
.Range("C" & k).Value = Left(.Range("C" & k).Value, Len(.Range("C" & k).Value) - 2) 'BT- _
Name korrigieren
Next
'Datum und Uhrzeiten formatieren
.Columns("J").NumberFormat = "dd.mm.yyyy"
.Columns("M").NumberFormat = "dd.mm.yyyy"
.Columns("K").NumberFormat = "hh:mm:ss"
.Columns("N").NumberFormat = "hh:mm:ss"
'Nicht benötigte Spalten entfernen
'.Columns("I").Delete
'.Columns("K").Delete
'Tabellenüberschriften
.Range("A1").Value = "Barcode"
.Range("B1").Value = "Masterbarcode"
.Range("C1").Value = "BT-Name"
.Range("D1").Value = "PIN"
.Range("E1").Value = "LIBname"
.Range("F1").Value = "AnalyseTyp"
.Range("G1").Value = "Fehlercode"
.Range("H1").Value = "Benutzer"
.Range("J1").Value = "AOI Datum"
.Range("K1").Value = "AOI Uhrzeit"
.Range("M1").Value = "Rep Datum"
.Range("N1").Value = "Rep Uhrzeit"
.Range("O1").Value = "LP Nr."
.Range("P1").Value = "Prüfung"
.Rows(1).NumberFormat = "General"
'Formatierungen
.Rows(1).Font.Bold = True
.Columns("A:M").HorizontalAlignment = xlRight
.Rows(1).HorizontalAlignment = xlLeft
.Columns("A:A").ColumnWidth = 7.43
.Columns("B:B").ColumnWidth = 13.71
.Columns("C:C").ColumnWidth = 8.43
.Columns("D:D").ColumnWidth = 3.43
.Columns("E:E").ColumnWidth = 7.86
.Columns("F:F").ColumnWidth = 11.14
.Columns("G:G").ColumnWidth = 10.29
.Columns("H:H").ColumnWidth = 8.29
.Columns("J:J").ColumnWidth = 9.86
.Columns("K:K").ColumnWidth = 10.57
.Columns("L:L").ColumnWidth = 10
.Columns("M:M").ColumnWidth = 10.71
.Columns("N:N").ColumnWidth = 5.43
.Columns("O:O").ColumnWidth = 7.29
End With
End Sub
Habe in der Datei versucht den Code etwas anzupassen, da der Import der Daten für euch nicht möglich ist.Ich denke der Fehler liegt da, wo die letzten 6 Ziffern des Wertes erstmal in eine Zelle geschrieben werden und dann erst formatiert. Dadurch gehen vorrangehende Nullen wahrscheinlich flöten.
Wie gehe ich das Problem am besten an?
Danke und freundliche Grüße an alle!