Anzeige
Archiv - Navigation
588to592
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
588to592
588to592
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

makro läuft zu lange

makro läuft zu lange
25.03.2005 03:58:15
Gabor
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

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
makro läuft zu lange_zusatz
25.03.2005 04:30:30
Gabor
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
AW: makro läuft zu lange
25.03.2005 04:42:52
Herbert
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
Anzeige
AW: makro läuft zu lange
25.03.2005 05:51:54
Gabor
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.
AW: Verbesserungsvorschlag
25.03.2005 12:01:15
Martin
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
Anzeige
AW: Verbesserungsvorschlag
25.03.2005 14:53:24
Gabor
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
Anzeige
AW: Verbesserungsvorschlag
25.03.2005 15:38:45
Herbert
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
AW: Verbesserungsvorschlag
25.03.2005 19:26:34
Martin
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
Anzeige
jetzt wird's ihm wahrscheinlich zu schnell....o.T.
25.03.2005 21:02:29
Herbert
gruß Herbert
AW: jetzt wird's ihm wahrscheinlich zu schnell....o.T.
26.03.2005 04:36:53
Gabor
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

Anzeige
AW: jetzt wird's ihm wahrscheinlich zu schnell....o.T.
26.03.2005 10:51:24
Martin
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
Anzeige
AW: jetzt wird's ihm wahrscheinlich zu schnell....
26.03.2005 14:29:54
Gabor
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.
AW: jetzt läufts nur noch 2,02 sec
26.03.2005 18:23:44
Gabor
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.
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige