Registriert seit: 18.04.2014
Version(en): Office 2010
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?
Registriert seit: 14.04.2014
Version(en): 2003, 2007
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
Registriert seit: 18.04.2014
Version(en): Office 2010
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.
Registriert seit: 14.04.2014
Version(en): 2003, 2007
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
Registriert seit: 18.04.2014
Version(en): Office 2010
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.
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo Uwe,
coole Methode.
Hatte ich auch noch nicht gesehen.
Gruß Atilla
Registriert seit: 18.04.2014
Version(en): Office 2010
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.
Registriert seit: 18.04.2014
Version(en): Office 2010
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.
Registriert seit: 14.04.2014
Version(en): 2003, 2007
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