Office: (Office 2010) Langsames Makro

Hallo ihr Lieben,

habe ein Makro, welches zwar gut funktioniert, aber sehr langsam ist. Die üblichen Standards wie Screenupdate ausschalten habe ich bereits eingefügt.
Ich habe in einem Blog gelesen, dass For-Schleifen ein Makro extrem bremsen können, habe auch eine For-Schleife dabei, weiß aber leider nicht wie ich die umgehen kann.

Vielleicht liegt die Bremse auch ganz wo anders...

Hier mein Code:

Code:

Sub Ist_Arbeit()

Dim EndeZ As Long
Dim EndeZ2 As Long
Dim EndeS As Long
Dim EndeS2 As Long
Dim lngLastRow As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Sheets("Ist-Aufwand1").Select

'Filter löschen (alle Informationen anzeigen)
If Sheets("Ist-Aufwand1").FilterMode = True Then
Sheets("Ist-Aufwand1").ShowAllData
End If

'Größe der Tabelle Ist-Aufwand auslesen
lngLetzteZeile = Sheets("Ist-Aufwand1").Range("A65536").End(xlUp).Row

'in Tabellenblatt Ist-Aufwand1 ein Spalte D einfügen und dort das Jahr des Aufwandes eintragen
With Sheets("Ist-Aufwand1")
Sheets("Ist-Aufwand1").Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Ist-Aufwand1").Range("D4").FormulaR1C1 = "=TEXT(C[-1],""JJJJ"")"
Sheets("Ist-Aufwand1").Range("D4").AutoFill Destination:=Range("D4:D" & lngLetzteZeile)

'Monat des Aufwandes in Spalte E eintragen
Sheets("Ist-Aufwand1").Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Ist-Aufwand1").Range("E4").FormulaR1C1 = "=TEXT(C[-2],""MMMM"")"
Sheets("Ist-Aufwand1").Range("E4").AutoFill Destination:=Range("E4:E" & lngLetzteZeile)

'in Tabelle Ist-Aufwand eine Spalte I für den Kostensatz einfügen und mittels SVerweis eintragen
Sheets("Ist-Aufwand1").Columns("I:I").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Ist-Aufwand1").Range("I4").FormulaR1C1 = "=VLOOKUP(C[-1],'Stundensätze1'!C[-6]:C[-4],3,0)"
Sheets("Ist-Aufwand1").Range("I4").AutoFill Destination:=Range("I4:I" & lngLetzteZeile)

'Spalte J für Kosten einfügen und berechnen
Sheets("Ist-Aufwand1").Columns("J:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Ist-Aufwand1").Range("J4").FormulaR1C1 = "=RC[-4]*RC[-1]"
Sheets("Ist-Aufwand1").Range("J4").AutoFill Destination:=Range("J4:J" & lngLetzteZeile)
End With
  
'Hilfsblatt einfügen
Sheets.Add.Name = "Übergang"

Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long

'Zeilengröße des Tabellenblatt "Übergang" auslesen
ZeileMax = Sheets("Ist-Aufwand1").UsedRange.Rows.Count
n = 3

'aus Tabelle nur Projekte von 2015 filtern
For Zeile = 3 To ZeileMax
    If Sheets("Ist-Aufwand1").Cells(Zeile, 4).Value = "2015" Then
        Sheets("Übergang").Cells(n, 1).Value = Sheets("Ist-Aufwand1").Cells(Zeile, 5).Value
        Sheets("Übergang").Cells(n, 2).Value = Sheets("Ist-Aufwand1").Cells(Zeile, 6).Value
        Sheets("Übergang").Cells(n, 3).Value = Sheets("Ist-Aufwand1").Cells(Zeile, 10).Value
        n = n + 1
    End If
Next Zeile
    
With Sheets("Übergang")
'Monate in Spalte E eintragen
Sheets("Übergang").Range("E1").FormulaR1C1 = "Januar"
Sheets("Übergang").Range("E1").AutoFill Destination:=Range("E1:E12"), Type:=xlFillDefault
    
'Summe des Aufwands der Monate bilden und in Spalte F schreiben
Sheets("Übergang").Range("F1").FormulaR1C1 = "=SUMIF(C[-5]:C[-3],C[-1],C[-4])"
Sheets("Übergang").Range("F1").AutoFill Destination:=Range("F1:F12"), Type:=xlFillDefault

'Summe der Kosten des Monats bilden und in Spalte G schreiben
Sheets("Übergang").Range("G1").FormulaR1C1 = "=SUMIF(C[-6]:C[-4],C[-2],C[-4])"
Sheets("Übergang").Range("G1").AutoFill Destination:=Range("G1:G12"), Type:=xlFillDefault
End With
    
'Werte vom Hilfstabellenblatt in die Monatsübersicht übertragen
Sheets("Monatsübersicht").Range("E17").Value = Sheets("Übergang").Range("F1").Value
Sheets("Monatsübersicht").Range("F17").Value = Sheets("Übergang").Range("F2").Value
Sheets("Monatsübersicht").Range("G17").Value = Sheets("Übergang").Range("F3").Value
Sheets("Monatsübersicht").Range("H17").Value = Sheets("Übergang").Range("F4").Value
Sheets("Monatsübersicht").Range("I17").Value = Sheets("Übergang").Range("F5").Value
Sheets("Monatsübersicht").Range("J17").Value = Sheets("Übergang").Range("F6").Value
Sheets("Monatsübersicht").Range("K17").Value = Sheets("Übergang").Range("F7").Value
Sheets("Monatsübersicht").Range("L17").Value = Sheets("Übergang").Range("F8").Value
Sheets("Monatsübersicht").Range("M17").Value = Sheets("Übergang").Range("F9").Value
Sheets("Monatsübersicht").Range("N17").Value = Sheets("Übergang").Range("F10").Value
Sheets("Monatsübersicht").Range("O17").Value = Sheets("Übergang").Range("F11").Value
Sheets("Monatsübersicht").Range("P17").Value = Sheets("Übergang").Range("F12").Value

Sheets("Monatsübersicht").Range("E18").Value = Sheets("Übergang").Range("G1").Value
Sheets("Monatsübersicht").Range("F18").Value = Sheets("Übergang").Range("G2").Value
Sheets("Monatsübersicht").Range("G18").Value = Sheets("Übergang").Range("G3").Value
Sheets("Monatsübersicht").Range("H18").Value = Sheets("Übergang").Range("G4").Value
Sheets("Monatsübersicht").Range("I18").Value = Sheets("Übergang").Range("G5").Value
Sheets("Monatsübersicht").Range("J18").Value = Sheets("Übergang").Range("G6").Value
Sheets("Monatsübersicht").Range("K18").Value = Sheets("Übergang").Range("G7").Value
Sheets("Monatsübersicht").Range("L18").Value = Sheets("Übergang").Range("G8").Value
Sheets("Monatsübersicht").Range("M18").Value = Sheets("Übergang").Range("G9").Value
Sheets("Monatsübersicht").Range("N18").Value = Sheets("Übergang").Range("G10").Value
Sheets("Monatsübersicht").Range("O18").Value = Sheets("Übergang").Range("G11").Value
Sheets("Monatsübersicht").Range("P18").Value = Sheets("Übergang").Range("G12").Value

'Übergangsblatt löschen
Sheets("Übergang").Delete

'in Tabellenblatt Ist-Aufwand die eingefügten Spalten wieder löschen
Sheets("Ist-Aufwand1").Columns("D:D").Delete Shift:=xlToLeft
Sheets("Ist-Aufwand1").Columns("D:D").Delete Shift:=xlToLeft
Sheets("Ist-Aufwand1").Columns("G:G").Delete Shift:=xlToLeft
Sheets("Ist-Aufwand1").Columns("G:G").Delete Shift:=xlToLeft
  
Sheets("Monatsübersicht").Select

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True

Vielen Dank im Vorraus!

Liebe Grüße

Lindaa

 

Hai,
habe deinen Code ein bisschen aufgeräumt. Da ich leider nicht komplett sehen kann, was dein Code machen muss, habe ich nur das geändert, wovon ich ausgehe, dass es genauso funktioniert wie dein Code. Code ist ungetestet. Für rauchende Rechner o.ä. wird, wie immer, keine Haftung übernommen. Ich empfehle auch in VBA unter dem Reiter "Extras", dort unter Optionen den 2. Eintrag "Variablendeklaration erforderlich" aktivieren. So schreit VBA direkt rum, wenn du eine Variable verwendest, die nicht deklariert wurde, Kehrseite ist, dass VBA direkt meckert, wenn etwas nicht stimmt, obwohl es auf den ersten Blick für dich stimmt. Kann manchmal nerven.

Code:

Option Explicit 'Erscheint wenn "Variablendeklaration erforderlich" aktiviert ist.
Sub Ist_Arbeit()

Dim intLastRow%, intZeile%, i% 'Als Integer deklariert. Wertebereich von -32.767 bis +32.767. Sollte eigentlich ausreichen. % ist die Kurzform für "as Integer".

'Folgende Variabeln in deinem Code nicht gefunden, deswegen als Kommentar markiert. Verkürzt auch die Abarbeitungszeit ;)
'
'Dim EndeZ&, EndeZ2&, EndeS&, EndeS2& '&-Zeichen hat die gleiche Bedeutung wie "as Long", spart einiges an Tipselkram :)
'
'

Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .EnableEvents = False
End With

'Hilfsblatt einfügen
Sheets.Add ("Übergang")

'Arbeitsblätter an Variabeln übergeben
With ActiveWorkbook
    Set sh1 = .Sheets("Ist-Aufwand1")
    Set sh2 = .Sheets("Monatsübersicht")
    Set sh3 = .Sheets("Übergang")
End With

'Filter löschen (alle Informationen anzeigen)
If sh1.FilterMode = True Then
    sh1.ShowAllData
End If

'Größe der Tabelle Ist-Aufwand auslesen
intLastRow = sh1.Range("A65536").End(xlUp).Row 'Auf richte Deklaration achten, deklariert wurde LngLastRow, verwendet hast du LngLetzteZeile. Jede Variable die nicht deklariert wird, deklariert VBA automatisch als String, welcher Resourcen fressend ist.

With sh1
    .Columns("D:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'Spalte D und E einfügen
    .Range("D4").FormulaR1C1 = "=TEXT(C[-1],""JJJJ"")" 'In Spalte D die Formel eintragen
    .Range("E4").FormulaR1C1 = "=TEXT(C[-2],""MMMM"")" 'In Spalte E die Formel eintragen
    .Range("D4", "E4").AutoFill Destination:=Range("D4:E" & intLastRow) 'Beide Spalten bis zur letzten verwendeten Zeile füllen
    .Columns("I:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'In Spalte I und J einfügen
    .Range("I4").FormulaR1C1 = "=VLOOKUP(C[-1],'Stundensätze1'!C[-6]:C[-4],3,0)" 'In Spalte I die Formel eintragen
    .Range("J4").FormulaR1C1 = "=RC[-4]*RC[-1]" 'In Spalte J die Formel eintragen
    .Range("I4", "J4").AutoFill Destination:=Range("I4:J" & intLastRow) 'Beide Spalten bis zur letzten verwendeten Zeile füllen
End With

i = 3

'aus Tabelle nur Projekte von 2015 filtern
For intZeile = i To intLastRow
    If sh1.Cells(intZeile, 4).Value = "2015" Then
        With sh3
            .Cells(i, 1).Value = sh1.Cells(intZeile, 5).Value
            .Cells(i, 2).Value = sh1.Cells(intZeile, 6).Value
            .Cells(i, 3).Value = sh1.Cells(intZeile, 10).Value
        End With
        i = i + 1
    End If
Next intZeile
    
With sh3
'Monate in Spalte E eintragen
    With .Range("E1")
        .FormulaR1C1 = "Januar"
        .AutoFill Destination:=Range("E1:E12"), Type:=xlFillDefault
    End With
    
    .Range("F1").FormulaR1C1 = "=SUMIF(C[-5]:C[-3],C[-1],C[-4])" 'Summe des Aufwands der Monate bilden
    .Range("G1").FormulaR1C1 = "=SUMIF(C[-6]:C[-4],C[-2],C[-4])" 'Summe der Kosten des Monats bilden
    .AutoFill Destination:=Range("F1:G12"), Type:=xlFillDefault 'In Spalte F und G die Daten übernehmen
End With
    
'Werte vom Hilfstabellenblatt in die Monatsübersicht übertragen
With sh2
    sh3.Range("F1", "F12").Copy Destination:=.Range("E17", "P17")
    sh3.Range("G1", "G12").Copy Destination:=.Range("E18", "P18")
End With

    'in Tabellenblatt Ist-Aufwand die eingefügten Spalten wieder löschen
    sh1.Columns("D:D").Delete Shift:=xlToLeft
    sh1.Columns("G:G").Delete Shift:=xlToLeft

'Übergangsblatt löschen
sh3.Delete

sh2.Select 'Wenn dein Makro in diesem Arbeitsblatt startet kann der Befehl gelöscht werden.

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

LG

 

Hallo
Ich arbeite bei größeren Auswertungen wie bei diesem Beispiel mit einer Collection- Variable.
Das Marko frägt eine Datenbanktabelle ab und gibt ausgewählte Werte in die Collection- Variable zurück.
Anschließend gäbe ich dies Informationen als Textdatei aus und lies diese wieder ein. Früher hatte ich eine direkte Datenbankverbindung im Excel nur die hat bei der Aktualisierung von ca. 45000 Zeilen mit Formeln ewig gebraucht. Jetzt bin ich in max. 30 Sekunden mit dieser Auswertung fertig.