Hallo Leute

vieleicht hat ja jemand zeit und lust mir zu helfen und mein Makro zu optimieren.

bis auf eine sache läuft es eigentlich, aber da ich nicht der VBA profi bin vermute ich, das ich da einige bomben eingebaut habe :D

Das ganze ist eine Zeit/Rang auswertung für Beschläunigungsrennen.

zum einen möchte ich eingaben manuell machen können und zum anderen werden Zeiten von einem externen Programm eingetragen.

Private Sub Worksheet_Change(ByVal Target As Range)
' Giebt zellen frei oder sperrt sie je nach durchgang (Lauf1, Lauf2,Lauf3 oder ID)
' das ganze wird durch drei butons ausgelöst die je ein makro zur sortierung auslösen und in zelle U2 Lauf1, Lauf2 Lauf3 oder ID eintragen.
' das hab ich gemacht weil es für jeden Lauf eine bedingte fürmatierung giebt, die bestimmte zellen einfärbt wenn in spalte "A" etwas eingetragen ist
ActiveSheet.Unprotect

If Range("$U$2").Value = "Lauf1" Then
Range("G2:H21").Locked = False
Else
Range("G2:H21").Locked = True
End If
If Range("$U$2").Value = "Lauf2" Then
Range("J2:K21").Locked = False
Else
Range("J2:K21").Locked = True
End If
If Range("$U$2").Value = "Lauf3" Then
Range("M2:N21").Locked = False
Else
Range("M2:N21").Locked = True
End If
If Range("$U$2").Value = "ID" Then
Range("A2:B21").Locked = False
Else
Range("A2:B21").Locked = True
End If

ActiveSheet.Protect



Dim rngBereich As Range, Prüfung, Frage
Set rngBereich = Union(Range("G2:G21"), Range("J2:J21"), Range("M2:M21"))
If Not Intersect(Target, rngBereich) Is Nothing Then

    On Error Resume Next ' verhindert Fehlermeldung wenn Arbeitsblatt bzw. zeitangaben durch Makro gelöscht werden
        
        If CheckBoxStoppuhr.Value = False Then ' prüft ob checkbox aktiv ist
            Application.EnableEvents = False
            GoTo Frage                         'wenn nicht dann gehe zu Frage
            Application.EnableEvents = True
        End If                                 'wenn Ja dann weiter
    
        If Target.Value = "" Then               'soll prüfen ob aktive zelle einen wert enthält und ob derwert kleiner als 0,0001 ist
            Application.EnableEvents = False
            GoTo Excel
            Application.EnableEvents = True
        End If
        
        If Target.Value < "0,001" Then
            Application.EnableEvents = False
            Target.Value = Target.Value * 86400
            Application.EnableEvents = True
        End If


Excel:
    AppActivate "Microsoft Excel"              ' stellt Excel in den Fordergrung, aber das soll er nur machen wenn checbox aktiv ist und eine eingabe in einer zelle erfolgt ist
                                                ' problem ist das es excel auch aufruft wenn keine eingabe ervolgt ist
Frage:
    Frage = MsgBox("War der Lauf gültig?", vbYesNo + vbMsgBoxSetForeground, "Gültigkeitsprüffung") 'soll abfragen ob ein Lauf gültig war, bei Ja danebenliegende Zelle leeren, bei Nein ein "x"
        If Frage = vbNo Then
            Application.EnableEvents = False
            Target.Offset(0, 1) = "x"
            Application.EnableEvents = True
        Else
            Application.EnableEvents = False
            Target.Offset(0, 1) = ""
            Application.EnableEvents = True
        
        
        
    End If

If CheckBoxStoppuhr.Value = True Then           ' prüft ob ceckbox Stoppuhr aktiv ist, wenn ja dan das externe Progrann Stoppuhr in den Fordergrund, wenn nein dann weiter
            Application.EnableEvents = False
            AppActivate "StoppUhr"
            Application.EnableEvents = True
        End If
End If
End Sub