Makrozeit verkürzen, Optimierung von VBA-Code

[kliffi01]

Hallo liebe Community,

ich möchte die Berechnungszeit für mein Makro verkürzen.
Dazu ersuche ich eure Hilfe, an welcher Stelle ich meinen Code noch verbessern kann.
Die Time-Elemente und MsgBox dienen nur zur Anzeige der Zeit. Das kommt am Ende wieder raus, wenn der Code MAXIMAL optimiert wurde
Danke vielmals!

Hier der Code:

Code:

Option Explicit
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Sub Worksheet_Change(ByVal target As Range)
Dim ZA As Long, lTime As Long
lTime = GetTickCount
   If Not Intersect(target, Range("D24:D117")) Is Nothing Then
   ZA = Len(target.Value)
   If target(1).Value = "" Then Exit Sub Else
   If ZA < 120 Then Range(target.Address).Font.Size = 11 Else
       If ZA > 119 And ZA < 151 Then Range(target.Address).Font.Size = 10 Else
           If ZA > 150 And ZA < 201 Then Range(target.Address).Font.Size = 9 Else
               If ZA > 200 And ZA < 241 Then Range(target.Address).Font.Size = 8 Else
                   If ZA > 240 And ZA < 351 Then Range(target.Address).Font.Size = 7 Else
                       If ZA > 350 And ZA < 401 Then Range(target.Address).Font.Size = 6 Else
                           If ZA > 400 Then MsgBox "Zeichenlimit von 400 erreicht. Bitte Inhalt in Mangel kürzen oder in dem darunterliegenden Feld weiterschreiben."
                           End If
lTime = GetTickCount - lTime
MsgBox "Makrolaufzeit " & CStr(lTime) & " ms", vbOKOnly
End Sub

Grüße und schönen 1. Mai

Martin

[MisterBurns]

Ob sich die Laufzeit nun wirklich in einer Weise verändert, die für dich spürbar ist, wage ich mal zu bezweifeln. Ich habe mit deinem Code eine Laufzeit von um die 30 ms erreicht.
Aber ich habe deinen Code etwas "verelegantet", für sowas bietet sich ja Select Case ideal an:

Code:

Private Sub Worksheet_Change(ByVal target As Range)
Dim ZA As Long, lTime As Long

If Not Intersect(target, Range("D24:D117")) Is Nothing Then
   lTime = GetTickCount
   ZA = Len(target.Value)
   If target(1).Value = "" Then Exit Sub

   Select Case ZA
       Case Is < 120
           Range(target.Address).Font.Size = 11
       Case 120 To 150
           Range(target.Address).Font.Size = 10
       Case 151 To 200
           Range(target.Address).Font.Size = 9
       Case 201 To 240
           Range(target.Address).Font.Size = 8
       Case 241 To 350
           Range(target.Address).Font.Size = 7
       Case 351 To 400
           Range(target.Address).Font.Size = 6
       Case Is > 400
           MsgBox "Zeichenlimit von 400 erreicht. Bitte Inhalt in Mangel kürzen oder in dem darunterliegenden Feld weiterschreiben."
   End Select

   lTime = GetTickCount - lTime
   MsgBox "Makrolaufzeit " & CStr(lTime) & " ms", vbOKOnly
End If

End Sub

Du könntest jetzt natürlich noch versuchen, in der Textlänge eine Logik zu finden, mit Modulo und Rest, welchen du dann von einer fix vorgegebenen Schriftgröße abziehst. Aber darüber nachzudenken fehlt mir am Tag der Arbeit echt die Muße.

[schauan]

Hallöchen,

mal zwei Anmerkungen.

ZA = Len(target.Value)

läuft auf einen Fehler hinaus, wenn Du einschl. einer Zelle im geprüften Bereich mehr als eine änderst.

Range(target.Address)

sollte stattdessen auch mit Target funktionieren

[Sulprobil]

Hallo,

Mein Vorschlag:
Option Explicit
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Sub Worksheet_Change(ByVal target As Range)
Dim ZA As Long, lTime As Long
lTime = GetTickCount
    If Not Intersect(target, Range("D24:D117")) Is Nothing Then
        If target(1).Value = "" Then Exit Sub Else
        ZA = Len(target.Value)
        If ZA > 400 Then
            MsgBox "Zeichenlimit von 400 erreicht. Bitte Inhalt in Mangel kürzen oder in dem darunterliegenden Feld weiterschreiben."
        Else
            Range(target.Address).Font.Size = Application.WorksheetFunction.Lookup(ZA, Array(0, 120, 151, 201, 241, 351), Array(11, 10, 9, 8, 7, 6))
        End If
    End If
lTime = GetTickCount - lTime
Debug.Print "Makrolaufzeit " & CStr(lTime) & " ms", vbOKOnly 'Mit STRG + G Immediate Window anzeigen lassen.
End Sub

Zur Laufzeit kann ich nichts sagen. Auf meinem i9 16 core sagt er immer nur 0 ms.
Ansonsten würde ich normalerweise von der Nutzung von Worksheet_Change Events abraten.

Viele Grüße,
Bernd P

[snb]

Alternative:

Code:

target.Font.Size = Switch(ZA < 120, 11, ZA < 151, 10, ZA < 201, 9, ZA < 241, 8, ZA < 351, 7)

Code:

target.Font.Size = Array(11, 10, 9, 8, 7, 6)(Application.Match(ZA, Array(0, 120, 151, 201, 241, 351), 1))

[Der Steuerfuzzi]

Hallo,

wäre das Zellformat "An Zellgröße anpassen" nicht eine alternative Möglichkeit?

[kliffi01]

Hallo,

ich habe all eure Vorschläge getestet, vielen lieben Dank dafür.
Das Ergebnis ist leider nicht was ich mir erhofft habe. Bei allen Varianten ist die kürzeste Berechnungszeit 172 ms. Egal wie oft ich es teste, kürzer als 172 ms ist nicht drin. Ich finde das abartig lang. Manche Zeiten gingen hoch bis 500-600 ms. Habe mich nun mit unserem internen IT-Service in Verbindung gesetzt und der möchte kommende Woche mein Office/Excel auf die neuste Version bringen. Also scheint etwas mit meiner Software faul zu sein.

Danke nochmal.


Grüße

Martin

[schauan]

Hallöchen,

mir ist aufgefallen, dass der erste Durchlauf recht lange dauert. Nach dem Programmieren waren es ca. 480 ms, dann nur noch 0. Nach erneutem Öffnen der Datei hatte ich beim ersten Durchlauf ca.180 MS, ab dem Zweiten dann auch 0 ms. Das ist dann reproduzierbar.

[snb]

Verwende screenupdating=false kombiniert mit:

Code:

target.Font.Size = Switch(ZA < 120, 11, ZA < 151, 10, ZA < 201, 9, ZA < 241, 8, ZA < 351, 7)

Excel 2000 war viel schneller als Excel 2013.

Aber letztendlicht ist es unsinncode: fontsize abhängig von textlength in der Zelle.

[mmat]

Hallo Schauan,

>> mir ist aufgefallen, dass der erste Durchlauf recht lange dauert. Nach dem Programmieren waren es ca. 480 ms, dann nur noch 0. Nach erneutem Öffnen der Datei
>> hatte ich beim ersten Durchlauf ca.180 MS, ab dem Zweiten dann auch 0 ms. Das ist dann reproduzierbar.

das ist recht logisch, wenn man sich vergegenwärtigt, dass der Code intern erstmal in ein etwas verdaulicheres Format überführt wird (Preprozessing, Tokenizing). Das kann man auch manuell auslösen, einfach den Knopf "Compillieren" drückt. Beim Neuöffnen der Datei muß das Makro halt erstmal in den Speicher geholt werden.

vg, MM