Schnelle Methode um Zeilen zu löschen
#1
Code:
With Worksheets("Auswahl")
      For n = .Cells(Rows.Count, 34).End(xlUp).Row To 1 Step -1
         If .Cells(n, 34) = "x" Then .Rows(n).Delete
      Next n
   End With

Kennt jemand eine VBA Lösung, die noch schneller ist, als diese um Zeilen zu löschen?
Top
#2
Hallo Achim,


hier eine schnellere Methode:

Code:
Sub test()
   Dim n As Long
   Dim rngZ As Range
   With Worksheets("Auswahl")
      For n = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
         If .Cells(n, 1) = "x" Then
            If rngZ Is Nothing Then
               Set rngZ = .Rows(n)
            Else
               Set rngZ = Union(rngZ, .Rows(n))
            End If
         End If
      Next n
   End With
   If Not rngZ Is Nothing Then
      rngZ.Rows.Delete
      Set rngZ = Nothing
   End If
End Sub
Gruß Atilla
Top
#3
Wow !!!
Eine deutlich schnellere Variante.
Ich werde die jetzt mal anpassen und fest einbauen.

Das sieht so aus, als ob alle betreffenden Zeilen als Bereich zusammengefasst und dann gelöscht werden.
Ich denke das wegen des Befehls UNION.
Den kenne ich gar nicht.... Habe ich noch nie verwendet.

Anyway....ich danke dir für die Hilfe.
Top
#4
Hallo Achim,

das hast Du richtig erkannt. Das ist in etwa so, wie wenn Du in der Tabelle die
besagten Zeilen mit gedrückter Strg Taste nacheinander markierst und am Ende
mit Zeilen löschen löschst.

Aber eine kleine Änderung sollte noch vorgenommen werden. Die letzte belegte Zeile
wird in der Schleife immer wieder neu berechnet. Das ist nicht so schön.
Mit der aufgezeigten Methode braucht man auch nicht mehr die Schleife rückwärts durchlaufen.
Dafür wird noch eine Variable benötigt.

So sollte es vernünftig aufgebaut sein:
Code:
Sub test()
   Dim n As Long, i As Long
   Dim rngZ As Range
   With Worksheets("Auswahl")
      n = .Cells(Rows.Count, 1).End(xlUp).Row
      For i = 1 To n
         If .Cells(i, 34) = "x" Then
            If rngZ Is Nothing Then
               Set rngZ = .Rows(i)
            Else
               Set rngZ = Union(rngZ, .Rows(i))
            End If
         End If
      Next i
   End With
   If Not rngZ Is Nothing Then
      rngZ.Rows.Delete
      Set rngZ = Nothing
   End If
End Sub
Gruß Atilla
Top
#5
Ja, ich hatte mich schon gewundert, dass nach einem weiteren Durchlauf
die Überschriften der dann eingelesenen Zeilen in meine Listbox weg waren.
Ich konnte das dann anpassen.
Aber so wie du es nochmal geändert hast, ist es noch besser.

Ich danke dir sehr für die Hilfe dazu.
Schönen Abend noch.
Top
#6
Hallo Achim,

kannst ja auch mal das testen:

Code:
Sub aaa()
  Application.ScreenUpdating = False
  With Columns(34)
    .Replace What:="x", Replacement:="#N/A", LookAt:=xlWhole, MatchCase:=False
    .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  End With
  Application.ScreenUpdating = True
End Sub

Gruß Uwe
Top
#7
Hallo Uwe,

coole Methode. Thumps_up
Hatte ich auch noch nicht gesehen.
Gruß Atilla
Top
#8
Hallo Uwe,

mein lieber Schwan.
Wie kommt man denn auf so eine - auch noch gut funktionierende - Lösung?

Danke dafür.
Wünsche allen ein super Weekend.
Top
#9
Hallo Uwe,

ich muss jetzt doch nochmal nachhaken zu deiner Lösung.
Wenn es mal dazu kommt, dass es keine Zeile zum Löschen gibt, erhält man eine Fehlermeldung.

Laufzeitfehler 1004
Keine Zellen gefunden
Und der Debugger markiert diese Zeile.
.SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete

Hast du das gewußt, dass diese Fehlermeldung erscheint?
Du musst das mal bei dir probieren.

Ich könnte ja ein On Error Resume Next einbauen,
aber das ist ja nicht gerade die eleganteste Lösung.
Top
#10
Hallo Achim,

Du kannst mit Zählenwnn vorher prüfen ob "x" in Spalte.

So sähe das per VBA aus:

Code:
If Application.CountIf(Columns(34), "x") Then
  With Columns(34)
    .Replace What:="x", Replacement:="#N/A", LookAt:=xlWhole, MatchCase:=False
    .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  End With
End If
Gruß Atilla
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste