Makro langsam
16.06.2005 07:40:02
Gisela
ich habe ein Problem mit dem folgenden Makro. Es läuft langsam. Bei mehrmaligem starten wird es immer langsamer.
So weit wie ich das herausbekommen habe, laufen "doppeltezeilenlöschen" und "Zeilenlöschen" sehr langsam.
Da meine Kenntnisse nur auf der Recorderarbeit beruhen, steh ich hier ziemlich ratlos rum. Die Makros hab ich mir aus der Recherche heraus gesucht.
Sub Aktionsübernahme2()
Application.ScreenUpdating = False
Sheets("Aktionen").Select
ActiveSheet.Unprotect ("mix1877")
Range("E4:G204").Select
Selection.Copy
'erste leere Zelle in A Daten copy
Sheets("cpo").Select
Range("A1").Select
ActiveCell.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Selection.ColumnWidth = 30.86
Columns("A:A").Select
Selection.ColumnWidth = 11.86
'Daten sortieren
Range("A6:AQ" & Cells(65536, 1).End(xlUp).Row).Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Call doppeltezeilenlöschen
Call ZeilenLöschen
Range("A6").Select
End Sub
Sub doppeltezeilenlöschen()
'Doppelte löschen wenn in B
Dim lLRow As Long, lRow As Long
lLRow = Cells(Rows.Count, 2).End(xlUp).Row
For lRow = lLRow To 1 Step -1
If WorksheetFunction.CountIf _
(Columns(2), Cells(lRow, 2).Value) > 1 Then
Rows(lRow).Delete
End If
Next lRow
End Sub
Sub ZeilenLöschen()
'in 205 Zeilen werden gelöscht, wenn in B kein Eintrag
Dim i As Long
For i = 205 To 1 Step -1
If Cells(i, 2) = "" Then Rows(i).Delete
Next i
End Sub
Kann mir bitte jemand helfen, wie ich das Makro entsprechend verändern muß.
Vielen Dank und Grüße
Gisela