Einfacher Code viel zu langsam!

Forumthread: Einfacher Code viel zu langsam!

07.11.2017 17:14:08

Tobias

Moin zusammen!
Folgender Code läuft viel zu langsam. Kann ich den irgendwie beschleunigen?
Sinn des Makros ist es, dass man in einer Übersichtstabelle einzelne Werte aus der Spalte C löscht. Anschließend klickt man auf das Makro. Nun soll automatisch erkannt werden, wo genau in Spalte C leere Felder sind. Entsprechende Zeilen sollen komplett gelöscht werden. Anschließend muss in Spalte B noch eine neue Rangfolge definiert werden.
Vorschläge, wie das schneller geht? Ich kann währenddessen Mittagessen gehen. :D


Private Sub CommandButton27_Click()
Dim ZeileMaxListe As Integer
Dim H As Integer
Dim R As Integer
Dim i As Integer
Dim letztezeile As Integer
Application.ScreenUpdating = False
ActiveWindow.Selection.Clear
letztezeile = Sheets("Übersicht").Cells(2500, 2).End(xlUp).Row
For i = 21 To letztezeile
With Sheets("Übersicht")
If .Cells(i, 3).Value = "" Then .Rows(i & ":" & i).Delete
i = i - 1
End With
Next
ZeileMaxListe = Tabelle2.Range("C21").End(xlDown).Row
Tabelle2.Range("B21:B" & ZeileMaxListe).Clear
R = 1
For H = 21 To ZeileMaxListe
Tabelle2.Cells(H, 2) = R
R = R + 1
Next H
Application.ScreenUpdating = True
End Sub

Viele Grüße!

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Einfacher Code viel zu langsam!

07.11.2017 17:22:58

Tobias
AW: Einfacher Code viel zu langsam!

07.11.2017 17:29:28

ChrisL
AW: Einfacher Code viel zu langsam!

07.11.2017 17:43:07

Tino
AW: Einfacher Code viel zu langsam!

07.11.2017 18:25:39

Daniel

AW: Einfacher Code viel zu langsam!

07.11.2017 17:22:58

Tobias


Private Sub CommandButton27_Click()
Dim ZeileMaxListe As Integer
Dim H As Integer
Dim R As Integer
Dim i As Integer
Dim letztezeile As Integer
Application.ScreenUpdating = False
ActiveWindow.Selection.Clear
letztezeile = Sheets("Übersicht").Cells(2500, 2).End(xlUp).Row
For i = 21 To letztezeile
With Sheets("Übersicht")
If .Cells(i, 3).Value = "" Then
.Rows(i & ":" & i).Delete
i = i - 1
End If
End With
Next
ZeileMaxListe = Tabelle2.Range("C21").End(xlDown).Row
Tabelle2.Range("B21:B" & ZeileMaxListe).Clear
R = 1
For H = 21 To ZeileMaxListe
Tabelle2.Cells(H, 2) = R
R = R + 1
Next H
Application.ScreenUpdating = True
End Sub

So natürlich... trotzdem langsam!

AW: Einfacher Code viel zu langsam!

07.11.2017 17:29:28

ChrisL

Hi Tobias
Hier ein erster Wurf...

Sub t()
Dim rngBereich As Range
Application.ScreenUpdating = False
With Worksheets("Übersicht")
Set rngBereich = .Range("B21:B" & .Cells(Rows.Count, 2).End(xlUp).Row).Offset(0, 1)
If WorksheetFunction.CountBlank(rngBereich) > 0 Then _
rngBereich.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
With .Range("B21:B" & .Cells(Rows.Count, 2).End(xlUp).Row).Offset(0, -1)
.Formula = "=A20+1"
.Value = .Value
End With
End With
End Sub

Für Anschlussfragen bitte eine kleine Beispieldatei. Bei vielen Formeln evtl. noch die automatische Berechnung auf manuell stellen.
cu
Chris

AW: Einfacher Code viel zu langsam!

07.11.2017 17:43:07

Tino

Hallo,
kannst mal diese Variante testen!

Private Sub CommandButton27_Click()
Dim rngHelp As Range, rngDelete As Range
Dim ZeileMaxListe&
With Sheets("Übersicht")
Set rngHelp = Sheets("Übersicht").UsedRange.EntireRow
Set rngHelp = rngHelp.Columns(.Columns.Count)
If rngHelp.Rows(rngHelp.Rows.Count).Row """",ROW(),TRUE)"
rngHelp.Value = rngHelp.Value
rngHelp.EntireRow.Sort rngHelp.Cells(1, 1), xlAscending, Header:=xlNo
On Error Resume Next
Set rngDelete = rngHelp.SpecialCells(xlCellTypeConstants, 4)
If Not rngDelete Is Nothing Then
rngDelete.EntireRow.Delete
End If
rngHelp.EntireColumn.Delete
On Error GoTo 0
End If
ZeileMaxListe = Tabelle2.Range("C21").End(xlDown).Row
With Tabelle2.Range("B21:B" & ZeileMaxListe)
.Clear
.FormulaR1C1 = "=ROW(R[-20]C1)"
.Value = .Value
End With
Application.ScreenUpdating = True
End Sub

Sonst wenn man schon mit einer Schleife Zeilen löschen will,
sollte man von unten nach oben die Schleife durchlaufen.
Gruß Tino

AW: Einfacher Code viel zu langsam!

07.11.2017 18:25:39

Daniel

HI
ich geh mal davon aus, dass Sheets("Übersicht") und TABELLE2 das selbe sind.
Das dürfte fertig sein, bevor du die Maus losgelassen hast.

Private Sub CommandButton27_Click()
With Sheets("Übersicht")
With .Cells.SpecialCells(xlCellTypeLastCell)
With .Worksheet.Range(.Offset(20 - .Row, 1), .Offset(0, 1))
.FormulaR1C1 = "=IF(RC3="""",0,Row())"
.Cells(1, 1).Value = 0
.EntireRow.RemoveDuplicates .Column, xlNo
.ClearContents
End With
End With
With .Range("B21:B" & .Range("C21").End(xlDown).Row)
.Cells(1, 1).Value = 1
.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
End With
End With
End Sub

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Forumthread: Einfacher Code viel zu langsam!

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread