Thema Datum  Von Nutzer Rating
Antwort
Rot Makro Optimieren
 08.05.2014 16:04:40 zip
NotSolved

Ansicht des Beitrags:
Von:
zip		 Datum:
08.05.2014 16:04:40		 Views:
1369		 Rating:
     
Antwort:
  Ja
Thema:
Makro Optimieren

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.

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
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

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Makro Optimieren
 08.05.2014 16:04:40 zip
NotSolved