Geschwindigkeits-Optimierung
Marco
ich habe eine Routine geschrieben, die bei jeder Eingabe entweder eine Schulnote in Notenpunkte umrechnet und in die Nachbarzelle schreibt - oder eben umgekehrt. Ich hatte es vorher (natürlich unidirektional) ohne VBA sehr schnell, aber ich möchte die Möglichkeit bieten, wahlweise auch direkt Schulnoten einzugeben. Eine Gültigkeitsprüfung sichert natürlich die Eingaben ab.
Trotz mehrerer Stunden zum Teil erfolgreicher Tüftelei bekomme ich die Ausführung (bei den entsprechenden Zellen) nicht schneller als etwa eine Drittel Sekunde hin. Das hakt aber in der Praxis doch etwas arg bei schneller Eingabe von Daten. Ich bin etwas ratlos, wie ich den Code evtl. noch schneller machen kann.
Vielleicht kann mir jemand einen heißen Tipp geben?
Private Function not2pkt(n As String) As Byte
Dim i As Byte
For i = 0 To 15
If notennamenliste(i) = n Then
not2pkt = i
Exit For
End If
Next i
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim c As Long
Dim t As Single
On Error GoTo Errorhandling
t = Timer()
With Target
r = .Row
If (r 2) Then
c = .Column
Application.EnableEvents = False 'sonst werden Tochterevents getriggert -> _
rekursiver loop
If IsEmpty(notennamenliste) Then 'manchmal vergisst excel dummerweise daten aus _
glob. variablen
notennamenliste = Array("6", "5-", "5", "5+", "4-", "4", "4+", "3-", "3", "3+ _
_
_
", "2-", "2", "2+", "1-", "1", "1+")
End If
Select Case .Column
Case 10, 19, 22, 25, 28, 31, 34, 37, 40, 43, 46, 49, 52
If Range(Cells(r, c).Address).Value "" Then Range(Cells(r, c + 1). _
Address).Value = notennamenliste(.Value)
Case 11, 20, 23, 26, 29, 32, 35, 38, 41, 44, 47, 50, 53
If Range(Cells(r, c).Address).Value "" Then Range(Cells(r, c - 1). _
Address).Value = not2pkt(.Value)
Case Else
End Select
Application.EnableEvents = True
End If
End With
Debug.Print Timer() - t
Exit Sub