Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 18:49:56
merge & select
24.04.2024 17:19:09
Formel mit Index-Funktion
24.04.2024 16:19:42
SummeWenn / SummeWenns mit Bedingung wenn kleiner als dann
24.04.2024 14:48:50
"Eingabefeld" zwischen zwei Zeilen geht nicht weg.
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1140to1144
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1140to1144
1140to1144
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro beschleunigen

Makro beschleunigen
Henrik
Hallo zusammen,
besteht die Möglichkeit folgenden Code noch zu beschleunigen? letzteZeile liegt nämlich bei 162000. 
Sub loeschen()
Dim zae1 as Integer, letzteZeile as Double
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets(1)
letzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
For zae1 = letzteZeile To 2 Step -4
.Rows(zae1 & ":" & zae1 - 1).Delete
Application.StatusBar = "Counter: " & zae1
Next zae1
End With
Application.ScreenUpdating = True
End Sub

Danke schonmal im Voraus.
Gruß aus Niedersachsen.
Henrik

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro beschleunigen
03.03.2010 11:05:37
Josef

Hallo Henrik,
sollte etwas schneller sein.

Sub loeschen()
  Dim lngRow As Integer, lngLast As Double
  Dim rngDel As Range
  
  With ActiveWorkbook.Worksheets(1)
    lngLast = .Cells(.Rows.Count, 1).End(xlUp).Row
    For lngRow = 2 To lngLast Step 4
      If rngDel Is Nothing Then
        Set rngDel = .Cells(lngRow - 1, 1).Resize(2, 1)
      Else
        Set rngDel = Union(rngDel, .Cells(lngRow - 1, 1).Resize(2, 1))
      End If
    Next lngRow
  End With
  
  If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
  
  Set rngDel = Nothing
End Sub

Gruß Sepp

Anzeige
Application.Calculation = xlManual...
03.03.2010 11:50:32
Ramses
Hallo Sepp
sollte auch noch einiges bringen, wenn viele Formeln in der Mappe sind
Application.Calculation = xlAutomatic
zum Schluss dann wieder aktivieren
Gruss Rainer
AW: Makro beschleunigen
03.03.2010 12:11:24
Josef

Hallo Henrik,
hier noch eine Lösung die sicher schneller ist.


Sub loeschen()
  Dim lngLast As Double
  
  On Error GoTo ErrExit
  Application.ScreenUpdating = False
  
  With ActiveWorkbook.Worksheets(1)
    lngLast = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Columns(1).Insert
    .Cells(1, 1) = "B"
    .Range(.Cells(2, 1), .Cells(lngLast, 1)).Formula = "=MOD(INT(ROW()/2),2)"
    .Range(.Cells(2, 1), .Cells(lngLast, 1)) = .Range(.Cells(2, 1), .Cells(lngLast, 1)).Value
    .Columns(1).Insert
    .Cells(1, 1) = "A"
    .Range(.Cells(2, 1), .Cells(lngLast, 1)).Formula = "=ROW()"
    .Range(.Cells(2, 1), .Cells(lngLast, 1)) = .Range(.Cells(2, 1), .Cells(lngLast, 1)).Value
    .Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), Order1:=xlAscending, header:=xlGuess
    .Range("A1").AutoFilter field:=2, Criteria1:="=0", Operator:=xlAnd
    .Range(.Cells(2, 2), .Cells(lngLast, 1)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .Range("A1").AutoFilter
    .Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), Order1:=xlAscending, header:=xlGuess
    .Columns("A:B").Delete
  End With
  
  ErrExit:
  Application.ScreenUpdating = True
End Sub

Gruß Sepp

Anzeige
Danke an alle, funktioniert
03.03.2010 15:21:40
Henrik
folgende Lösung führte zum gewünschten Ergebnis: 

Sub loeschen()
Dim lngLast As Double
On Error GoTo ErrExit
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets(1)
lngLast = .Cells(.Rows.Count, 1).End(xlUp).Row
.Columns(1).Insert
.Cells(1, 1) = "B"
.Range(.Cells(2, 1), .Cells(lngLast, 1)).Formula = "=MOD(INT(ROW()/2),2)"
.Range(.Cells(2, 1), .Cells(lngLast, 1)) = .Range(.Cells(2, 1), .Cells(lngLast, 1)).Value
.Columns(1).Insert
.Cells(1, 1) = "A"
.Range(.Cells(2, 1), .Cells(lngLast, 1)).Formula = "=ROW()"
.Range(.Cells(2, 1), .Cells(lngLast, 1)) = .Range(.Cells(2, 1), .Cells(lngLast, 1)).Value
.Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlGuess
.Range("A1").AutoFilter field:=2, Criteria1:="=0", Operator:=xlAnd
.Range(.Cells(2, 2), .Cells(lngLast, 1)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Range("A1").AutoFilter
.Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess
.Columns("A:B").Delete
End With
ErrExit:
Application.ScreenUpdating = True
End Sub

Danke nochmal
Anzeige
AW: Makro beschleunigen
03.03.2010 11:11:58
Yusuf
Moin,
ich hab es selber nie ausprobiert, deshalb kann ich nicht sagen ob es wirklich schneller ist.
Der Grundgedanke ist, dass man die zu loeschenden Zeilen "sammelt" und zum Schluss alle zusammen loescht.
Ich wuerde es so machen, dass ich die zu loeschenden Zeilen mit einem x in einer freien Zelle in der entsprechen Zeile (zb in der letzten Spalte) markiere. Am Ende dann nach dem x in der Spalte per Autofilter filtern und die angezeigten Inhalte entfernen.
Danach noch Sortieren, damit die Leerzeilen ans Ende kommen und nicht zwischendrin sind.
Das geht natuerlich nur, wenn die Reihenfolge irrelevant ist.
Gruß
Yusuf
Anzeige
Lösung ohne Schleife
03.03.2010 11:57:05
Reinhard
Hallo Henrik,
vielleicht so:
Spa ist Hilfsspalte, kannst eine andere freie nehmen, rechts von belegten Spalten. 
Sub trennen()
Dim Zei As Long, Z As Long, Merk
Const Spa As Long = 10
On Error GoTo Hell
Application.ScreenUpdating = False
Merk = Application.Calculation
Application.Calculation = xlCalculationManual
With ActiveSheet
Zei = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(Zei - 1, Spa), .Cells(Zei, Spa)) = ""
.Range(.Cells(Zei - 3, Spa), .Cells(Zei - 2, Spa)) = 1
.Range(.Cells(Zei - 3, Spa), .Cells(Zei, Spa)).Copy _
Destination:=Range(.Cells(Zei Mod 4 + 1, Spa), .Cells(Zei - 4, Spa))
.Range(.Cells(1, 1), .Cells(Zei, Spa)).Sort Key1:=.Cells(1, Spa), Order1:=xlAscending,  _
Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Z = .Cells(Rows.Count, Spa).End(xlUp).Row
.Range(.Cells(Z + 1, 1), .Cells(Zei, Spa)).Delete
Columns(Spa).ClearContents
End With
Hell:
Application.Calculation = Merk
Application.ScreenUpdating = True
End Sub

Gruß
Reinhard
Anzeige
Sorry, hab deine Antwort nicht gesehen. o.T.
03.03.2010 12:11:55
Josef
Gruß Sepp

Nachfrage zu xlGuess
03.03.2010 12:38:22
Reinhard
Hallo Sepp,
du benutzt xlGuess, da ich Sort nicht per Hand schreibe lasse ich es mir immer kurz aufzeichnen und passe es dann an.
Da ersetze ich immer dieses xlGuess durch das was ich will, xlNo z.B.
Insofern habe ich keine Erfahrungen mit xlGuess, aber mir ist unbehaglich wenn Excel da aufgrund der Daten irgendwie was festlegt.
Frage, kann man xlGuess vertrauen?
Gruß
REinhard
Anzeige
AW: Makro beschleunigen
03.03.2010 12:11:49
robert
hi,
dim zae1 as integer kann nicht stimmen bei 162000 zeilen-oder?
und lass einmal die Application.StatusBar = "Counter: " & zae1 weg
gruß
robert

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige