Makro beschleunigen(ohne Select Case?)

Sub FZ_berechnen() GetMoreSpeed (True) Range("AT1").Value = "alte Abrufe" Range("AU1").Value = "neue Abrufe" Range("AV1").Value = "alte FZ" Range("AW1").Value = "neue FZ" Range("AX1").Value = "Differenz" lnglast = Cells(Rows.Count, 1).End(xlUp).Row For Zeile = 3 To lnglast Select Case Cells(2, 34).Value Case Is = 0 Cells(2, 46).Value = "0" Cells(Zeile, 47).Value = "0" Case Is > 0 Cells(2, 34).Copy Cells(2, 46).Value = "0" Cells(2, 47).PasteSpecial Cells(2, 48) = "0" Range("AW2").FormulaR1C1 = "=RC[-13]+RC[-15]" Case Is 0,VLOOKUP(RC[-13],C[-13]:C[-12],1,FALSE),0)" 'wenn neue Abrufe Select Case Cells(Zeile, 47).Value Case Is >= 0 Cells(Zeile, 49).FormulaR1C1 = "=IF(AND(R[-1]C[-48]=RC[-48]),IF(RC[-3]0,VLOOKUP(RC[-13],C[-13]:C[-12],1,FALSE),0)" GetMoreSpeed (False) End Sub

Sub GetMoreSpeed(Optional ByVal Modus As Boolean = True) Dim intCalculation As Integer If Modus = True Then intCalculation = Application.Calculation With Application .ScreenUpdating = Not Modus .EnableEvents = Not Modus .Calculation = IIf(Modus = True, xlManual, intCalculation) .Cursor = IIf(Modus = True, 2, -4143) End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Ugur,
also, die erste Teil innerhalb des For ist zum grossen Teil unveränderbar, spricht, es wird 12.000 das gleich gemacht.
Bis auf die eine Kleinigkeit, aber da die Verwaltung des For an sich selbst performance mässig unbedeutend ist, kannst Du daher diese verdoppeln:


Sub FZ_berechnen()
Dim Zeile As Long
Dim lngLast As Long
GetMoreSpeed (True)
Range("AT1").Value = "alte Abrufe"
Range("AU1").Value = "neue Abrufe"
Range("AV1").Value = "alte FZ"
Range("AW1").Value = "neue FZ"
Range("AX1").Value = "Differenz"
lngLast = Cells(Rows.Count, 1).End(xlUp).Row
Select Case Cells(2, 34).Value
Case Is = 0
Cells(2, 46).Value = "0"
For Zeile = 4 To lngLast
Cells(Zeile, 47).Value = "0"
Next
Case Is > 0
Cells(2, 34).Copy
Cells(2, 46).Value = "0"
Cells(2, 47).PasteSpecial
Cells(2, 48) = "0"
Range("AW2").FormulaR1C1 = "=RC[-13]+RC[-15]"
Case Is 0,VLOOKUP(RC[-13],C[-13]:C[-12],1,FALSE),0)"
For Zeile = 3 To lngLast
'wenn neue Abrufe
If Cells(Zeile, 47).Value >= 0 Then
Cells(Zeile, 49).FormulaR1C1 = "=IF(AND(R[-1]C[-48]=RC[-48]),IF(RC[-3]0,VLOOKUP(RC[-13],C[-13]:C[-12],1,FALSE),0)"
GetMoreSpeed (False)
End Sub

Damit wird schon vieles beschleunigt.
Darüber hinaus, folgende "Vorschläge":
_ unter "Extras, Optionen" Variable Deklaration einschalten: ein Muss um besser zu werden,
_ entweder die Notation Cells(x, y) oder Range ("A1"), aber nicht vermischt. Das macht den Code schwer zu lesen damit fehleranfällig,
_ ein Select case mit nur einem Fall ist ein If. Bringt keine Performanceunterschied, sieht aber aufgeräumter,
_ in "GetMoreSpeed" muss Du die Variable intCalculation als Static deklarieren. Öffne das Direkt Fenster und setzte Haltepunkte (F9), um die Unterschied zu sehen:


Sub GetMoreSpeed(Optional ByVal Modus As Boolean = True)
Static intCalculation As Integer
If Modus = True Then intCalculation = Application.Calculation
With Application
.ScreenUpdating = Not Modus
.EnableEvents = Not Modus
.Calculation = IIf(Modus = True, xlManual, intCalculation)
.Cursor = IIf(Modus = True, 2, -4143)
End With
End Sub

VG
Yal

Hallo
ich habe die For Next Schleife in Case eliminiert, und sie durch Resize ersetzt. Das verlängert den Rangebereich ohne For Next Schleife!
Der wirklichje Zeitfresser ist m.E. die zweite For Next fur die Auswertung >= 0 und zweimal = 0 möglich ?
Kannst du diese Auswertung nicht in die darauf folgende Wenn Formel für die Spalten AW und AV MIT einbauen? Sie direkt an den Anfang stellen?
Dann kannst du diese Formel OHNE For Next in einem Rutsch kopieren. Ist das eine Alternative für dich. Probier es einfach mal aus. Vierl Glück ...
mfg Piet

Select Case Cells(2, 34).Value
Case Is = 0
Cells(2, 46).Value = "0"
Cells(4, 47).Resize(lngLast - 3, 1) = "0"
Case Is > 0
Cells(2, 34).Copy Cells(2, 47)
Cells(2, 46).Value = "0"
Cells(2, 48).Value = "0"
Range("AW2").FormulaR1C1 = "=RC[-13]+RC[-15]"
Case Is Cells(2, 34).Copy Cells(2, 46)
Cells(2, 47).Value = "0"
Cells(2, 49).Value = "0"
Range("AV2").FormulaR1C1 = "=RC[-12]+RC[-14]"
End Select

Beliebteste Forumthreads (12 Monate)

Makro beschleunigen(ohne Select Case?)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread