Sub BP()
Dim Tag As Date
Pfad = "c:\temp\"
With CreateObject("Scripting.Dictionary")
f = Dir(Pfad & "BP*.jpg")
Do While f <> vbNullString
Fz = Split(f, "_")
Kfz = Fz(0)
Zt = Split(Fz(1), ".")(0)
Tag = DateSerial(Left(Zt, 4), Mid(Zt, 5, 2), Mid(Zt, 7, 2))
hhmm = VBA.TimeSerial(Mid(Zt, 9, 2), Mid(Zt, 11, 2), Mid(Zt, 13, 2))
Tag = Tag + hhmm
If Not .exists(Kfz) Then
.Item(Kfz) = Tag
Else
.Item(Kfz) = .Item(Kfz) & "|" & Tag & "|" & Tag - CDate(.Item(Kfz))
End If
f = Dir
Loop
Cells(2, 1).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(1, 4), Array(2, 4), Array(3, 4)), _
TrailingMinusNumbers:=True
Columns("B:C").AutoFit
Columns("D").NumberFormat = "hh:mm:ss"
End With
End Sub