Makro beschleunigen?

10/12/2009 - 00:44 von Peter Schürer | Report spam
Hallo Zusammen,

XL2002.
Ich habe ein Makro, das die KW berechnen und eintragen soll. Das macht
es auch, ist aber sehr langsam. Könnte man das irgend wie beschleunigen?

Sub KW_aus_Datum()
'
' Die Kalenderwoche wird aus Spalte i "Termin" berechnet
Range("O2:P2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("N2").Select
Range("O3").Activate
ActiveCell.FormulaR1C1 = "=KALENDERWOCHE(RC[-6])"
ActiveCell.Copy
Range("N2").Activate
Selection.End(xlDown).Activate
ActiveCell.Offset(0, 1).Activate
Range(Selection, Selection.End(xlUp)).Activate
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("O2").Activate
ActiveCell.FormulaR1C1 = "KW"
Range("O2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("P3").Select
ActiveCell.FormulaR1C1 = "=Year(RC[-7])"
Range("P3").Select
Selection.NumberFormat = "yyyy"
Selection.Copy
Range("N2").Activate
Selection.End(xlDown).Activate
ActiveCell.Offset(0, 2).Activate
Range(Selection, Selection.End(xlUp)).Activate
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("P2").Activate
ActiveCell.FormulaR1C1 = "Jahr"
Range("P2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").Activate
Selection.End(xlToRight).Select
Selection.AutoFilter
Selection.AutoFilter
Rows("3:3").Hidden = True

Range("A2").Activate
End Sub


Danke und Gruß
Peter
 

Lesen sie die antworten

#1 Peter Schleif
10/12/2009 - 06:44 | Warnen spam
Peter Schürer schrieb am 10.12.2009 00:44 Uhr:

XL2002.
Ich habe ein Makro, das die KW berechnen und eintragen soll. Das macht
es auch, ist aber sehr langsam. Könnte man das irgend wie beschleunigen?



Schwer zu sagen, ohne die Daten zu kennen. Mit meinen wenigen Testdaten
làuft es nur 2 Sekunden. Soweit ich es verstanden habe, hast Du in
Spalte I Datumswerte. In den Spalten O+P möchtest Du die KW und das Jahr
berechnen lassen. Dazu tràgst Du die Formeln in O3+P3 ein und kopierst
diese nach unten - bis auf Höhe der letzten belegten Zelle von Spalte N.

- Ist das soweit richtig?
- Musst Du die Formeln wirklich immer wieder neu eintragen?
- Reicht es nicht sie einmal per Hand einzutragen?

Das Makro selbst enthàlt diverse überflüssige Anweisungen die vermutlich
durch den Makro-Recorder erzeugt wurden. Ich habe es mal bereinigt und
vorsichtshalber das Screen-Updating deaktiviert. Vielleicht bringt das
was. Im Code findest Du Kommentare, damit Du nachvollziehen kannst was
passiert. Eventuell ist auch das Setzen/Löschen bzw. Löschen/Setzen des
Autofilter zu teuer. Ohne Daten schwer zu sagen.

Peter

Sub KW_aus_Datum_Peter()

On Error GoTo fehler

'/Bildschirmaktualisierung ausschalten/
Application.ScreenUpdating = False

'/Überschrift setzen und Bereich löschen/
[O2:P2] = Array("KW", "Jahr")
Range([O3:P3], [O3:P3].End(xlDown)).ClearContents

'/Formeln in O3 und P3 eintragen/
[O3].FormulaR1C1 = "=KALENDERWOCHE(RC[-6])"
[P3].FormulaR1C1 = "=Year(RC[-7])"

'/Spalten O und P ausfüllen, solange Spalte N belegt ist/
[O3:P3].Copy
With [N2].End(xlDown).Offset(0, 1)
Range([O4:P4], .Resize(1, 2)).PasteSpecial xlPasteFormulas
Range([P3], .Offset(0, 1)).NumberFormat = "0"
End With

'/Autofilter setzen und wieder löschen bzw. umgekehrt/
[A2].End(xlToRight).AutoFilter
[A2].End(xlToRight).AutoFilter

'/Zeile 3 ausblenden, A2 auswàhlen/
Rows("3:3").Hidden = True
[A2].Select

fehler:
'/Bildschirmaktualisierung wieder einschalten/
Application.ScreenUpdating = True

End Sub

Ähnliche fragen