makro läuft zu lange

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: makro läuft zu lange von: Gabor
Geschrieben am: 25.03.2005 03:58:15

Hallo liebe Excelfreunde,
ich habe 2 Schleifen, die aber mehrere Minuten brauchen bis sie ein Ergebnis bringen. Die Tabelle hat mehrere Tausend Zeilen und es soll jede Zeile gelöscht werden, wenn folgende Bedingungen erfüllt sind:
1. Wenn in Spalte I ein Wert ungleich B steht (beginnend ab Zeile 4)
2. Wenn in Spalte AH eine leere Zelle ist. (beginnend ab Zeile 4).
Hier der jetzige CODE:


Sub all()
For i = Cells(Rows.Count, 9).End(xlUp).Row To 4 Step -1
If Cells(i, 9) <> "" And Cells(i, 9) <> "B" Then Rows(i).delete Shift:=xlUp
Next i
'Wenn in Spalte AH eine leere Zelle ist, wird diese Zeile gelöscht
For i = Cells(Rows.Count, 1).End(xlUp).Row To 4 Step -1
If Cells(i, 34) = "" Then Rows(i).delete Shift:=xlUp
Next i
End Sub

Bild


Betrifft: makro läuft zu lange_zusatz von: Gabor
Geschrieben am: 25.03.2005 04:30:30

Hallo ich habe noch eine Zusatzfrage:
Könnt ihr mir bitte schreiben wie ich die folgende Zeile ändern muss, damit "Autoausfüllen" sich nach der Zeilenzahl von Blatt b Spalte A richtet und nicht nach der in dem der CODE steht.

Sheets("calc").Select
Range("A3").Select
ActiveCell.FormulaR1C1 = "=b!R[1]C"
Range("A3").Select
Selection.AutoFill Destination:=Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row), Type:=xlFillDefault


Bild


Betrifft: AW: makro läuft zu lange von: Herbert H.
Geschrieben am: 25.03.2005 04:42:52

Hallo Gabor,

so dauert das löschen von 4000 Zeilen bei mir 17 sec...


Sub all()
Dim i%
Dim t As Single
t = Timer
With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
End With
For i = Cells(Rows.Count, 9).End(xlUp).Row To 4 Step -1
If Cells(i, 9) <> "" And Cells(i, 9) <> "B" Or _
   Cells(i, 34) = "" Then Rows(i).Delete Shift:=xlUp
Next i
With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
End With
MsgBox "Dauer: " & Format(Timer - t, "00.00" & "sec")
End Sub



Gruß Herbert


Bild


Betrifft: AW: makro läuft zu lange von: Gabor
Geschrieben am: 25.03.2005 05:51:54

Herbert,
hab vielen Dank, aber bei läuft deine Version 328,69 sec bei 4205 Zeilen.

Kannst du mir auch bitte die Frage mit dem Autoausfüllen beantworten?

Ich kann erst wieder in 15 Stunden antworten - vielen Dank für deine Bemühungen.


Bild


Betrifft: AW: Verbesserungsvorschlag von: Martin Beck
Geschrieben am: 25.03.2005 12:01:15

Hallo,

die Bedingung für Spalte AH muß nicht in die Schleife einbezogen werden.


Sub all()
Dim i%
Dim t As Single
t = Timer
With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
End With
Columns("AH:AH").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For i = Cells(Rows.Count, 9).End(xlUp).Row To 4 Step -1
If Cells(i, 9) <> "" And Cells(i, 9) <> "B" Then Rows(i).Delete Shift:=xlUp
Next i
With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
End With
MsgBox "Dauer: " & Format(Timer - t, "00.00" & "sec")
End Sub


Was schneller ist, mußt Du testen.

Gruß
Martin Beck


Bild


Betrifft: AW: Verbesserungsvorschlag von: Gabor
Geschrieben am: 25.03.2005 14:53:24

Ich kann das jetzt noch nicht testen aber schon einmal vielen Dank. Könnte mann die Bedingung für die Spalte I nicht ähnlich formulieren. In der Spalte I stehen nur die Werte A , B , C , D oder E und ich brauche nur die Zeilen in denen ein B in Spalte I steht.

Könnt ihr mir bitte auch noch meine Zusatzfrage mit dem Autoausfüllen beantworten?

Hallo ich habe noch eine Zusatzfrage:
Könnt ihr mir bitte schreiben wie ich die folgende Zeile ändern muss, damit "Autoausfüllen" sich nach der Zeilenzahl von Blatt b Spalte A richtet und nicht nach der in dem der CODE steht.

Sheets("calc").Select
Range("A3").Select
ActiveCell.FormulaR1C1 = "=b!R[1]C"
Range("A3").Select
Selection.AutoFill Destination:=Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row), Type:=xlFillDefault


Bild


Betrifft: AW: Verbesserungsvorschlag von: Herbert H.
Geschrieben am: 25.03.2005 15:38:45

probiers einmal so:

ungetestet:


Sub x()
dim sh as Worksheet
set sh = sheets("Calc")
Sh.[A3].FormulaR1C1 = "=b!R[1]C"
Sh.[a3].AutoFill Destination:=sh.Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row), Type:=xlFillDefault
End Sub


gruß Herbert


Bild


Betrifft: AW: Verbesserungsvorschlag von: Martin Beck
Geschrieben am: 25.03.2005 19:26:34

Hallo Gabor,

erstelle eine Hilfsspalte, z.B. in BA. Schreibe in BA4 die Formel

=1/(I4="B")

und kopiere diese soweit nach unten wie nötig. Dann folgendes Makro:


Sub all()
Dim i%
Dim t As Single
t = Timer
With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
End With
Columns("AH:AH").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Columns("BA:BA").SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
End With
MsgBox "Dauer: " & Format(Timer - t, "00.00" & "sec")
End Sub


Gruß
Martin Beck


Bild


Betrifft: jetzt wird's ihm wahrscheinlich zu schnell....o.T. von: Herbert H.
Geschrieben am: 25.03.2005 21:02:29

gruß Herbert


Bild


Betrifft: AW: jetzt wird's ihm wahrscheinlich zu schnell....o.T. von: Gabor
Geschrieben am: 26.03.2005 04:36:53

Martin,
hier meine Version nach deiner Anleitung(bleibt aber immer an der Zeile
Columns("AJ:AJ").SpecialCells(xlCellTypeFormulas, 16).EntireRow.delete
hängen.

Sub Makro_hilfsspalte()
'
Dim i%
Dim t As Single
    Range("AJ4").Select
    ActiveCell.FormulaR1C1 = "=1/(RC[-27]=""B"")"
    Selection.AutoFill Destination:=Range("AJ4:AJ" & Cells(Rows.Count, 1).End(xlUp).Row), Type:=xlFillDefault
t = Timer
With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
End With
Columns("AH:AH").SpecialCells(xlCellTypeBlanks).EntireRow.delete
Columns("AJ:AJ").SpecialCells(xlCellTypeFormulas, 16).EntireRow.delete
With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
End With
MsgBox "Dauer: " & Format(Timer - t, "00.00" & "sec")
End Sub



Bild


Betrifft: AW: jetzt wird's ihm wahrscheinlich zu schnell....o.T. von: Martin Beck
Geschrieben am: 26.03.2005 10:51:24

Hallo Gabor,

in den Spalten I und AH muß natürlich etwas sinnvolles stehen, sonst werden in AJ durch die Formeln keine Fehlermeldungen der Form #DIV/0 erzeugt und das Makro bleibt hängen. Versuche mal


Sub Makro_hilfsspalte()
'
Dim i%
Dim t As Single
t = Timer
z = Range("AH65536").End(xlUp).Row
Range("AJ4:AJ" & z).Formula = "=1/(I4=""B"")"
With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
End With
Columns("AH:AH").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Columns("AJ:AJ").SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
End With
MsgBox "Dauer: " & Format(Timer - t, "00.00" & "sec")
End Sub


Gruß
Martin Beck


Bild


Betrifft: AW: jetzt wird's ihm wahrscheinlich zu schnell.... von: Gabor
Geschrieben am: 26.03.2005 14:29:54

Martin,
nochmals Danke für deine Geduld, ich konnte jetzt noch nicht an der Originaldatei testen aber an meinem Nachbau läufts. Ich habe jetzt nur noch ein kleines Problem: Die Zeilen 1 und 2 sind nicht mit Daten gefüllt und werden durch Columns("AH:AH").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
mit gelöscht. Wie muß ich den Bereich definieren, dass erst ab Zeile 3 gelöscht wird.

Vorab vielen Dank.


Bild


Betrifft: AW: jetzt läufts nur noch 2,02 sec von: Gabor
Geschrieben am: 26.03.2005 18:23:44

Ich habe das makro jetzt wie folgt geändert:
z = Range("AH65536").End(xlUp).Row
Range("AJ4:AJ" & z).Formula = "=1/(I4=""B"")"

Columns("AJ:AJ").SpecialCells(xlCellTypeFormulas, 16).EntireRow.delete
Range("AH4:AH" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.delete

Vielen Dank für die umfangreiche Hilfe.


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Arbeitsmappe fixieren"