Sub ImportFlexlmLog()
'
'
    FileEinlesen = Application.GetOpenFilename("Flexlm Logfile (*.log), *.log", , "Logfile auswählen")
    '# Wenn das Einlesen abgebrochen wird, ist der Wert der Variable = "Falsch"
    If FileEinlesen = "Falsch" Then
        Exit Sub
    End If

    Workbooks.OpenText Filename:=FileEinlesen _
        , Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
        :=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False _
        , Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 3), Array(5, 3), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1), Array(16, 1), Array(17, 1)), TrailingMinusNumbers:=True

'    Mal das automatische Rechnen ausschalten
    With Application
        .Calculation = xlManual
        .MaxChange = 0.001
    End With
' Leere Spalte einfügen
    Cells(1, 1).EntireColumn.Insert
   
'  Zeilen einfügen
    Rows("1:4").Select
    Selection.Insert Shift:=xlDown
    
'  und beschriften
'    Range("A1").Select
'    ActiveCell.FormulaR1C1 = "Auswertung"
    Cells(1, 1).Value = "Auswertung"
    Cells(1, 3).Value = "Logfile"
    Cells(3, 1).Value = "Datum (aus Timestamp)"
    Cells(3, 2).Value = "Freie Liz."
    Cells(3, 3).Value = "Zeit"
    Cells(3, 4).Value = "Verursacher"
    Cells(3, 5).Value = "Aktion"
    Cells(3, 6).Value = "Data1"
    Cells(3, 7).Value = "Data2"
'    Cells(4, 1).FormulaR1C1 = "=R[1]C"   ' muss am Ende gesetzt werden
    Cells(4, 2).Value = 17
    Cells(4, 3).Value = "Startwert"
    
'  die ganze Einführung rausschmeissen bis zum ersten Eintrag "TIMESTAMP"
'  nach Zeile 3 natürlich ;)

    Range("A4").Select
    i = Cells.Find(What:="TIMESTAMP", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Row
    While i > 5
       i = i - 1
       Rows(i).Delete
    Wend
    
' weitere zeilen markieren zum Löschen und Ausrichten in Feld H
' Range("A4").Select
' Spalte1 bekommt einen index

i = 5
Nutzen = i
While (Cells(i, 4).Value > "")
    Cells(i, 1).Value = i
    Vergleichstext = Cells(i, 4).Text
    If ((Vergleichstext = "IN:") _
    Or (Vergleichstext = "OUT:") _
    Or (Vergleichstext = "TIMESTAMP")) Then
        Cells(i, 8).Value = "Zeileschieben"
        Nutzen = Nutzen + 1
    Else
        Vergleichstext = Cells(i, 5).Text
        If ((Vergleichstext = "IN:") _
        Or (Vergleichstext = "OUT:") _
        Or (Vergleichstext = "TIMESTAMP")) Then
            Nutzen = Nutzen + 1
        Else
            Cells(i, 8).Value = "Zeilelöschen"
        End If
    End If
' die swofficepro brauchen wir auch nicht
    If ((Cells(i, 5).Text = "swofficepro") _
    Or (Cells(i, 6).Text = "swofficepro")) Then
        Cells(i, 8).Value = "Zeilelöschen"
        Nutzen = Nutzen - 1
    End If
    i = i + 1
Wend

letzteZeile = i - 1
' MsgBox ("gelesen: " & letzteZeile & "  Nutzbar: " & Nutzen)

' Löschen und Schieben - Bereiche markieren und als ganzes bearbeiten.
'   Erst mal sortieren, damit das geht
    Range(Cells(5, 1), Cells(letzteZeile, 20)).Sort Key1:=Range("H5"), Order1:=xlAscending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
'   Schieben suchen
    Range("H1").Select
    i = Cells.Find(What:="Zeileschieben", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Row
    j = i
    While Cells(j + 1, 8).Value = "Zeileschieben"
        j = j + 1
    Wend
    ' i ist die erste, j ist die letzte Zeile
    ' alle verschieben und den Eintrag "Zeileschieben" wieder entfernen
    Range(Cells(i, 2), Cells(j, 2)).Insert Shift:=xlShiftToRight
    Range(Cells(i, 9), Cells(j, 9)).Delete

'   Löschen suchen
    Range("H1").Select
    i = Cells.Find(What:="Zeilelöschen", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Row
    j = i
    While Cells(j + 1, 8).Value = "Zeilelöschen"
        j = j + 1
    Wend
    'i ist wieder die erste, j die letzte Zeile
    Range(Cells(i, 1), Cells(j, 1)).EntireRow.Delete
    
'   Einträge Löschen
'    Range(Cells(5, 9), Cells(j, 9)).Delete

'   Zurücksortieren
    Range(Cells(5, 1), Cells(Nutzen, 20)).Sort Key1:=Range("A5"), Order1:=xlAscending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    
    
' Range("A1").Select

    letzteZeile = Nutzen + 1

' die Formeln eintragen und Formatieren
    Range(Cells(5, 1), Cells(letzteZeile, 1)).Select
    Selection.FormulaR1C1 = "=IF(RC[4]=""TIMESTAMP"",RC[5],R[-1]C)"
    Selection.NumberFormat = "m/d/yyyy"
    Range(Cells(5, 2), Cells(letzteZeile, 2)).Select
    Selection.FormulaR1C1 = "=IF(RC[4]=""solidworks"",R[-1]C-(RC[3]=""OUT:"")+(RC[3]=""IN:""),R[-1]C)"
    Selection.NumberFormat = Standard
    
    Columns("A").ColumnWidth = 18
'    Range(Cells(5, 1), Cells(letzteZeile, 1)).NumberFormat = "m/d/yyyy"
'    Range(Cells(5, 2), Cells(letzteZeile, 2)).NumberFormat = Standard
    Range(Cells(5, 3), Cells(letzteZeile, 3)).NumberFormat = "hh:mm:ss"

'  mal einen senkrechten Strich
    Range(Cells(1, 2), Cells(letzteZeile, 2)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

'schön farbig
Range(Cells(4, 2), Cells(letzteZeile, 2)).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
    Formula1:="0"
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
    Formula1:="3"
Selection.FormatConditions(2).Interior.ColorIndex = 45

'   Schnell das automatische Rechnen wieder einschalten
    With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001
    End With
    
' Kopf ergänzen
    Cells(4, 1).FormulaR1C1 = "=R[1]C"
    Cells(1, 4).Value = Cells(5, 1).Value
    Cells(1, 5).Value = "bis"
    Cells(1, 6).Value = Cells(letzteZeile, 1).Value
    
' Und Auswerten

Range("A3", Cells(letzteZeile, 7)).Select
Selection.Subtotal GroupBy:=1, Function:=xlMin, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2

Range("A1").Select

'und nun speichern unter ....
    FileSpeichern = Application.GetSaveAsFilename(fileFilter:="Exceldatei (*.xls), *.xls")
    '# Wenn das Einlesen abgebrochen wird, ist der Wert der Variable = "Falsch"
    If FileSpeichern = "Falsch" Then
        Exit Sub
    End If
    
    ActiveWorkbook.SaveAs Filename:=FileSpeichern, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

    
End Sub