VBA-Laufzeit-Problem
17.08.2003 09:16:39
Günther Woll
unten stehendens Makro läuft im Testmodus(F8)bei schnellen wiederholtem drücken in 20 sec ab und braucht mit F5 oder mit Schalterclick ca. 3-5 min. Dabei erscheint unten links die Meldung "Berechne Zellen". Ein Zähler zählt dabei mehrmals gemächlich in 5er Schritten hoch. Die Tabelle enthält ca. 15.000 Zeilen un ca. 30 Spalten. Was kann ich tun um mit der F5-taste die gleiche Laufzeit wie mit der F8-Taste zu erreichen? Für euren Tip danke ich Euch im voraus.
Gruß
Günther
Public RefSpalte As Integer
Public AktZeile As Integer
Public LZeile As Integer
Sub Schritt01()
Initialisieren
DatenSelektieren
Initialisieren
Berechnung01
End Sub
Sub Initialisieren()
Range("A1").Select
LZeile = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1").Select
Selection.End(xlToRight).Select
RefSpalte = ActiveCell.Column
End Sub
Sub DatenSelektieren()
Cells(1, RefSpalte + 23) = "Abg+Zu"
Cells(2, RefSpalte + 23) = "=SUM(RC[-12]:RC[-1])+RC[-13]"
Cells(2, RefSpalte + 23).Select
FormelNachUntenKopieren
Cells.Select
Selection.Sort Key1:=Cells(2, RefSpalte + 7), Order1:=xlAscending, Key2:=Cells(2, RefSpalte + 23) _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom
For i = 2 To LZeile
If Cells(i, RefSpalte + 7) > 0 Or Cells(i, RefSpalte + 23) > 0.99 Then
Exit For
End If
Next i
Rows("2:" & i & "").Select
Selection.Delete Shift:=xlUp
End Sub
Sub Berechnung01()
Cells(1, RefSpalte + 23) = "Abgw 12"
Cells(2, RefSpalte + 23) = "=SUM(RC[-12]:RC[-1])*RC[-14]"
Cells(2, RefSpalte + 23).Select
FormelNachUntenKopieren
Cells(1, RefSpalte + 24) = "SklWert"
Cells(2, RefSpalte + 24).Select
KO1 = "R2C" & RefSpalte + 2 & ":R" & LZeile & "C" & RefSpalte + 2
KO2 = "R2C" & RefSpalte + 23 & ":R" & LZeile & "C" & RefSpalte + 23
Cells(2, RefSpalte + 24) = "=SUMIF(" & KO1 & ",RC[-22]," & KO2 & ")"
FormelNachUntenKopieren
End Sub
Sub FormelNachUntenKopieren()
AktZeile = ActiveCell.Row
i = LZeile - AktZeile + 1
Selection.Resize(i).Select
Selection.Offset(0, 0).FillDown
End Sub