Makro beschleunigen

[ari-2001]

  Mappe für cef.xlsm (Größe: 1,85 MB / Downloads: 7) Hallo,

ich habe mir zum löschen von unnötigen Zeilen ein Makro zusammengeschustert, dass genau die Zeilen löscht,
wenn in Spalte P irgendwann nichts mehr steht.

Funktionieren tut es, aber es dauert ein wenig, da das Makro die Zeile löscht, den Rest hochschiebt, die nächste Zeile löscht, wieder hochschiebt usw.usw.

Hier das Makro dazu:

Sub FahrtenLoeschen()
 
     Dim i As Long
     Dim letzteZeile As Long
     Dim suchBereich As Range
     Dim gefunden As Range
     Dim ersterTreffer As String
     Dim suchWert As String
     suchWert = "" 'hier kommt der Suchwert rein, der gelöscht werden soll
    
     With ThisWorkbook.Sheets("Testblatt")
         letzteZeile = .Range("A" & Rows.Count).End(xlUp).Row
         Set suchBereich = .Range("P4:P" & letzteZeile)
         Set gefunden = suchBereich.Find(What:=suchWert, LookAt:=xlPart)
         If Not gefunden Is Nothing Then
             ersterTreffer = gefunden.Address
             Do
                 gefunden.Activate
                 ActiveCell.EntireRow.Delete shift:=xlUp
                 Set gefunden = suchBereich.Find(What:=suchWert, LookAt:=xlPart)
             Loop While Not gefunden Is Nothing
         End If
     End With
 
End Sub



Kann man das Makro irgendwie beschleunigen, oder so umbauen, dass er alle Zeilen auf einmal löscht, wenn in der Spalte P nichts mehr steht?
Wichtig ist für mich nur, dass er erst ab P4 nachschaut, weil über P4 noch benötigte Überschriften stehen.

Testdatei anbei.

Vielen dank im Voraus.

Gruß
Andreas

[Kuwer]

Hallo Andreas,

Sub FahrtenLoeschen()
     Dim letzteZeile As Long
     With ThisWorkbook.Sheets("Testblatt")
         letzteZeile = .Range("A" & Rows.Count).End(xlUp).Row
         .Range("P4:P" & letzteZeile).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
     End With
End Sub

Gruß Uwe

[Klaus-Dieter]

Hallo Andreas,

beschleunigt vom rund drei Minuten auf wenige Sekunden:

Code:

Option Explicit

Sub l?schen()
    Dim strTxt As String
    Dim lngLeZeile As Long
    lngLeZeile = Range("A1").End(xlDown).Row
    strTxt = InputBox("Suchbegriff eingeben", "Löschen")
    Range("A3:Q" & lngLeZeile).AutoFilter Field:=16, Criteria1:=strTxt
    Range("A3:Q" & lngLeZeile).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
End Sub

Upps, da war jemand schneller, lasse das wegen des etwas anderen Ansatzes mal stehen.

[ari-2001]

Vielen Dank,

funzt innerhalb von Bruchteilen einer Sekunde.

Merci,
Andreas

[ari-2001]

Hallo,

wie kann ich das folgende Makro umbauen, das es Zellen löscht,
die ein "V" enthalten?

Sub FahrtenLoeschen()
     Dim letzteZeile As Long
     With ThisWorkbook.Sheets("Testblatt")
         letzteZeile = .Range("A" & Rows.Count).End(xlUp).Row
         .Range("P4:P" & letzteZeile).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
     End With
End Sub


Dieses Makro löscht alle Zeilen, die in Spalte "P" ab der Zeile 4 nichts mehr entalten.

Funzt auch super!

Aber ich würde auch noch das gleiche Makro benötigen, dass (wenn ich es später ausführe, also ein zweites Makro), alle Zeilen löscht, die ein "V" in der besagten Spalte enthält.

Viele Grüße
Andreas

[Klaus-Dieter]

Hallo Andreas,

dann hast du dich mit meinem Vorschlag nicht beschäftigt. Sonst hättest du gemerkt, dass man dort den Begriff, nach dem gelöscht werden soll, per Inputbox festlegen kann.

[ari-2001]

Hallo Klaus,

natürlich habe ich mich mit deinem Vorschlag beschäftigt, aber ich möchte ja keine Inputbox haben.

Ich werde versuchen, dein Beispiel ohne Inputbox hinzubekommen.

Viele Grüße
Andreas

[Klaus-Dieter]

Hallo Andreas,

dann musst du den roten Text gegen deinen Suchbegriff tauschen: Range("A3:Q" & lngLeZeile).AutoFilter Field:=16, Criteria1:=strTxt

Diese Zeile: strTxt = InputBox("Suchbegriff eingeben", "Löschen") ist dann über.

[snb]

Code:

Sub M_snb()
    With Tabelle3.UsedRange.Columns(16)
        .Replace "V", "", 1
        .SpecialCells(4).EntireRow.Delete
    End With
End Sub

[ari-2001]

Hallo snb,

das ist auch cool, aber was bedeutet:

Tabelle3.UsedRange.Columns(16) ?

Ich verstehe, dass es die 16 Spalte ist, aber wieso Tabelle3?

Ich würde mich sehr über eine Antwort freuen.

Gruß
Andreas