AW: VBA-Ablauf wird immer langsamer
27.06.2004 17:30:36
Many
Hallo Sepp,
sorry, bin selten im Forum, mache setzen Autom. Grußformel drunter.
Sinn und Zweck des Makros
von z.Zt. 109 Einträgen von Adressen und Geburtsdaten., wird beim Betätigen dieses Buttons, die Liste nach den Geburtsmonaten sortiert. Jetzt hab ich sie erweitert, damit der akt. Monat (fast) in der Mitte der List gesetzt wird, so das am Ende des Jahres der Dez. und Jan. sich hintereinander in der Mitte befinden.
Die Geb.tage werden durch ein anderes Makro verschieden farblich hervorgehoben.
(Vor-Rückschau - Zeitraum frei wählbar und akt.Geb.)
Private Sub btnGebMon_Click()
On Error Resume Next
ActiveSheet.Protect UserinterfaceOnly:=True
Range("A4").Activate
SortiereAufw ("N4"), ("M4") 'Liste wird nach erst Monat, dann nach Tag sortiert.
letzterEintrag ' Letzte Zeile ermitteln, Var.= letzteZeile
ActiveSheet.Unprotect
aktMon = Month(Date)
Range("N:N").Select ' in dieser Spalte sind nur die Monate der Geb.-Daten
Finde (aktMon)
ActiveCell.Offset(0, -11).Select
zeza = ActiveCell.Row
If zeza + (Fix(letzteZeile / 2)) > letzteZeile Then
Zeilgrenze = zeza - (Fix(letzteZeile / 2))
If Zeilgrenze < 5 Then GoTo weiterGeb '3 Zeilen werden als Kopfzeilen verwendet.
umsetz = "4:" + Trim(Str(Zeilgrenze)) 'Vielleicht kann dies eleganter umsetzten !!
Rows(umsetz).Select
Selection.Cut
Rows(letzteZeile + 1).Select
Selection.Insert Shift:=xlDown
Else
Zeilgrenze = zeza + (Fix(letzteZeile / 2))
If zeza > letzteZeile Then GoTo weiterGeb
umsetz = Trim(Str(Zeilgrenze)) + ":" + Trim(Str(letzteZeile)) 'Vielleicht kann dies eleganter umsetzten !!
Rows(umsetz).Select
Selection.Cut
Rows("4:4").Select
Selection.Insert Shift:=xlDown
End If
weiterGeb:
mkAdr = ActiveCell.Address
Columns("M:BG").Select
Selection.EntireColumn.Hidden = True
Application.ScreenUpdating = True
ActiveWindow.ScrollRow = (Fix(letzteZeile / 2)) - 4
Cells(zeza, 1).Select
End Sub
Bestimmt kann man einiges besser Programmieren, für Tipps bin ich dankbar.
Gruß Many