VBA Makro optimieren

Hallo Zusammen :)
Ich bin recht neu in der Excel-VBA Welt und möchte nun ein bereits bestehendes VBA Makro optimieren.
Genauer gesagt geht es um eine Verkürzung der Rechendauer, da das Makro derzeit ca. eine halbe Stunde in Anspruch nimmt.
Hat einer von euch Tipps für mehr Geschwindigkeit?
Hier der Code:


Private Sub btnOutputTable_Click()
Dim calcState As Integer
Dim lngI As Long
' Freeze screen updating and calculation
Application.StatusBar = "Calculating results..."
Application.ScreenUpdating = False
calcState = Application.Calculation
Application.Calculation = xlCalculationManual
' Delete output sheet
If ActiveSheet.Range("rngPasteDelete").Value = "Ja" Then
Sheets(ActiveSheet.Range("rngPasteSheet").Value).Cells.Delete
End If
' Copy headers to output sheet
Range("rngCopyHeaders").Copy
Sheets(ActiveSheet.Range("rngPasteSheet").Value).Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
' Run through loans
For lngI = ActiveSheet.Range("rngFrom").Value To ActiveSheet.Range("rngTo").Value
' Set ID to current loan
Application.StatusBar = "Calculating results: " & lngI & " / " & ActiveSheet.Range("rngTo").Value
ActiveSheet.Range("rngID").Value = lngI
' Calculate
Application.Calculate
' Copy results to output sheet
Sheets(ActiveSheet.Range("rngPasteSheet").Value).Cells(lngI + 1, 1).Resize(1, Range("rngCopyResults").Rows.Count) = Application.WorksheetFunction.Transpose(Range("rngCopyResults").Value2)
Next lngI
' Format outputs
Range("rngCopyResults").Copy
Sheets(ActiveSheet.Range("rngPasteSheet").Value).Cells(1, 1).Resize(ActiveSheet.Range("rngTo").Value + 1, Range("rngCopyResults").Rows.Count).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Sheets(ActiveSheet.Range("rngPasteSheet").Value).Cells(1, 1).Resize(ActiveSheet.Range("rngTo").Value + 1, Range("rngCopyResults").Rows.Count).Font.ColorIndex = xlAutomatic
Sheets(ActiveSheet.Range("rngPasteSheet").Value).Cells(1, 1).Resize(ActiveSheet.Range("rngTo").Value + 1, Range("rngCopyResults").Rows.Count).Borders.LineStyle = xlLineStyleNone
Sheets(ActiveSheet.Range("rngPasteSheet").Value).Cells(1, 1).Resize(1, Range("rngCopyResults").Rows.Count).HorizontalAlignment = xlLeft
' Reset screen updating and calculation
Application.StatusBar = "Resetting view..."
Range("A1").Select
ActiveSheet.Range("rngID").Value = ActiveSheet.Range("rngFrom").Value
Application.Calculate
Application.Calculation = calcState
Application.ScreenUpdating = True
Application.StatusBar = False

Würde es etwas bringen "Application.Enable = False" oder "Application.CutCopyMode = False" einzubauen?
Über diese Ausdrücke bin ich während meiner Forums- und Internetrecherche gestolpert.
Ich bin über jegliche Tipps dankbar!
Viele Grüße
Felix

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
prinizipell kannst du ja die Automatische Neuberechnung aktiv lassen, wenn du sowieso die Formeln immer neu berechnen musst.
wenn du ein Application.Calculation einsetzt, bringt es dir nichts die automatische Neuberechnung auszuschalten, dann kannst du sie anlassen und dir diesen Befehl sparen.
Was ggf machen kannst um Rechenzeit zu sparen ist, dass du eben nicht alle Formeln in der Mappe neu berechnest, sondern nur die notwendigen.
Mit Range("A1:A10").Calculate werden nur die Zellen im Bereich A1:A10 neu berechnet und die anderen Zellen nicht.
Wenn du in der Datei viele Formeln hast, die für die gewünschte Berechnung nicht erforderlich sind, kannst du damit ggf Rechenzeit sparen indem du sie von der Neuberechnung ausschließt.
was vielleicht ein bisschen was bringt, wäre auch die lesenden Zellzugriffe zu reduzieren und mit Variablen zu arbeiten.
also statt jedesmal: Sheets(ActiveSheet.Range("rngPasteSheet").Value) in der Schleife zu verwenden, weist du das Sheet zu beginn (vor der Schleife!) einmal einer Variablen zu und verwendest dann diese im Code:


Set shPaste = Sheets(ActiveSheet.Range("rngPasteSheet").Value)
PasteZeilen = Range("rngCopyResults").Rows.Count
shPaste.Cells(lngI + 1, 1).Resize(1, PasteZeilen).value = ...

was du auch mal ausprobieren kannst, ist anstelle des Worksheetfunction.Transpose die Zellen zu kopieren und dann transponiert einzufügen:
also aus


Sheets(ActiveSheet.Range("rngPasteSheet").Value).Cells(lngI + 1, 1).Resize(1, Range("rngCopyResults").Rows.Count) = Application.WorksheetFunction.Transpose(Range("rngCopyResults").Value2)

wird (hier jetzt noch ohne Variablen)


Range("rngCopyResults").Copy
Sheets(ActiveSheet.Range("rngPasteSheet").Value).Cells(lngI + 1, 1).PasteSpecial xlpastevalues, Transpose:=true

hier brauchst du den Zielbereich nicht in der Größe anpassen, was die Sache etwas vereinfacht.
ob jetzt das .Value = .Value schneller ist oder Copy-PasteValues, kann man so pauschal nicht sagen, das hängt von den Umständen ab und du müsstest testen.
da beim Copy-PasteValues allerdings der Zielbereich selektiert wird, könnte es helfen zusätzlich die automatischen Events auszuschalten (Application.EnableEvents = false)
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread