Microsoft Excel

Herbers Excel/VBA-Archiv

Geschwindigkeits-Optimierung | Herbers Excel-Forum


Betrifft: Geschwindigkeits-Optimierung von: Marco Bolten
Geschrieben am: 08.01.2010 04:04:07

Hallo,

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 < 53) And (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

  

Betrifft: AW: Geschwindigkeits-Optimierung von: Josef Ehrensberger
Geschrieben am: 08.01.2010 07:37:37

Hallo Marco,

probier mal.

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim vntRet As Variant
  Dim t As Single
  
  On Error GoTo ErrorHandling
  t = Timer()
  
  With Target
    If .Row < 53 And .Row > 2 Then
      Application.EnableEvents = False 'sonst werden Tochterevents getriggert -> _
        rekursiver loop

      
      If IsEmpty(notennamenliste) Then
        initArray
      End If
      
      Select Case .Column
        Case 10, 19, 22, 25, 28, 31, 34, 37, 40, 43, 46, 49, 52
          If .Value <> "" Then .Offset(0, 1) = notennamenliste(.Value)
        Case 11, 20, 23, 26, 29, 32, 35, 38, 41, 44, 47, 50, 53
          If .Value <> "" Then
            vntRet = Application.Match(.Text, notennamenliste, 0)
            If IsNumeric(vntRet) Then
              .Offset(0, -1) = vntRet - 1
            End If
          End If
        Case Else
      End Select
    End If
  End With
  
  Debug.Print Timer() - t
  
  ErrorHandling:
  Application.EnableEvents = True
End Sub

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public notennamenliste As Variant

Sub initArray()
  notennamenliste = Array("6", "5-", "5", "5+", "4-", "4", "4+", "3-", "3", "3+", "2-", "2", "2+", "1-", "1", "1+")
End Sub



Gruß Sepp



  

Betrifft: AW: Geschwindigkeits-Optimierung von: Marco Bolten
Geschrieben am: 08.01.2010 14:11:42

Hi Sepp,
vielen Dank für Deine Hilfe. Ich habe wieder einmal eine Menge gelernt, und der Code ist tatsächlich noch mal um knapp 10% schneller geworden. Es ist zwar immer noch merklich, aber ich glaube, besser geht es einfach nicht.
Heißen Dank und herzliche Grüße,
Marco