Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Einfacher Code viel zu langsam!

Forumthread: Einfacher Code viel zu langsam!

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!
Anzeige

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

Betreff
Datum
Anwender
Anzeige
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!
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige