Löschen mehrerer Zeilen wenn Bedingung nicht erfül

Forumthread: Löschen mehrerer Zeilen wenn Bedingung nicht erfül

18.05.2016 13:12:41

Jens

Hallo zusammen,
ich möchte in einer Tabelle (Umfang ca. 20.000 Zeilen) alle Zeilen löschen bei denen in den Spalten F2:F und G2:G eine Bedingung gleichzeitig nicht erfüllt ist. Diese Bedingung steht in einem anderen Arbeitsblatt in Zelle E15.
Wie stelle ich das mit vba am besten an? Kann mir bitte jemand weiterhelfen?
BG Jens

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Makrorekorder (und wenig abändern)

18.05.2016 13:22:44

lupo1

Wahrheitsspalte, die die Bedingung auswertet, in H2:H... anfügen
Nach WAHR autofiltern
Gesamtes Filtrat in neue Tabelle kopieren

AW: Löschen mehrerer Zeilen wenn Bedingung nicht erfül

18.05.2016 19:59:42

Piet

Hallo Jens,
anbei eine kurze, getestete Makrolösung. Ich denke sie funktioniert gut.
Bitte in ein normales Modulblatt kopieren und testen.
Es müssen evtl. kleine Korrekturen vorgenommen werden bzgl. deiner Tabellen Namen
With Worksheets("Tabelle1") - ist bei mir die Tabelle1, in der gesucht und gelöscht wird.
Const QTab = "Auswertung" - muss geaendert werden auf die Tabelle wo der Suchwert steht.
Wenn diese Namen korrigiert sind müsste das Makro einwandfrei laufen. Viel Spass ...
mfg Piet

Option Explicit      '18.5.2016  Piet für Herber Forum
Const QTab = "Auswertung"     'Name der Quell-Tabelle  (E15)
Dim lz1 As Long, lz2 As Long
Dim Wert As String, j As Long
Sub Tabelle_ausfiltern()
With Worksheets("Tabelle1")
'Vergleichswert aus Qell-Tabelle laden
Wert = Worksheets(QTab).Range("E15")
'LastZell in Spalte F + G ermittlen
lz1 = .Cells(Cells.Rows.Count, 6).End(xlUp).Row
lz2 = .Cells(Cells.Rows.Count, 7).End(xlUp).Row
If lz2

AW: Warte, hatte Denkfehler ...

18.05.2016 20:02:42

Piet

Sorry Denkfehler von mir
es heisst ja, wenn Bedinung -gleichzeitig nicht erfüllt ist-
Muss die İf Bedinungen korrigieren, warte solange mit dem Test

AW: neuer Code

18.05.2016 20:13:08

Piet

Hi Jens
anbei ein neuer Code, ich denke jetzt müsste er funktionieren.
Zur Sicherheit aber bitte eine Testdatei öffnen, alle Daten kopieren
und das Makro zuerst in einer Test Datei ausprobieren. Ist Sicherer.
Makro funktionieren sehr gut, aber wenn die Logik nicht stimmt löschen
sie auch Problemlos die falschen Daten. Deshalb bitte in Testdatei testen.
mfg Piet

Option Explicit      '18.5.2016  Piet für Herber Forum
Const QTab = "Auswertung"     'Name der Quell-Tabelle  (E15)
Dim lz1 As Long, lz2 As Long
Dim Wert As String, j As Long
Sub Tabelle_ausfiltern()
With Worksheets("Tabelle1")
'Vergleichswert aus Qell-Tabelle laden
Wert = Worksheets(QTab).Range("E15")
'LastZell in Spalte F + G ermittlen
lz1 = .Cells(Cells.Rows.Count, 6).End(xlUp).Row
lz2 = .Cells(Cells.Rows.Count, 7).End(xlUp).Row
If lz2 > lz1 Then lz1 = lz2
'Rückwaertsschleife zum vergleichen mit löschen
For j = lz1 To 2 Step -1
'Spalte F + G = gleicher Wert
If .Cells(j, 6)  Wert And _
.Cells(j, 7)  Wert Then
.Rows(j).Delete Shift:=xlUp
End If
Next j
End With
End Sub

AW:Zeilen löschen - Schnell und Einfach

18.05.2016 20:21:23

Daniel

Hi
Zeilen löschen mit Bedingung geht in Excel seit 2007 am schnellsten und einfachsten so (egal ob von Hand oder mit VBA):
1. Schreibe in eine Hilfsspalte am Tabellenende eine Formel, welche alle Zeilen die gelöscht werden sollen mit 0 kennzeichnet und die die stehen bleiben sollen mit der Zeilenummer.
in deinem Fall könnte die Formel sein: =Wenn(Oder(F1=TabelleX!$E$15;G1=TabelleX!$E$15);Zeile();0)
(vermutlich, weil deine Beschreibung nicht eindeutig ist)
diese Formel dann bis ans Tabellenende runterziehen
2. in die Überschriftenzeile der Hilfsspalte die 0 schreiben
3. auf die ganze Tabelle die Funktion DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN anwenden, mit der Hilfsspalte als Kriterium und der Option "keine Überschrift"
4. Hilfssspalte wieder löschen
geht natürlich auch als Makro:

With ActiveSheet.Usedrange
With .columns(.Columns.count + 1)
.FormulaR1C1 = "=IF(OR(RC6=TabelleX!R15C5,RC7=TabelleX!R15C5),Row(),0)"
.Cells(1, 1).Value = 0
.EntireRow.RemoveDuplicates .column, xlno
.ClearContents
End With
End With

TabelleX natürlich noch durch den entsprechenden Namen austauschen.
Gruß Daniel

AW: Löschen mehrerer Zeilen wenn Bedingung nicht erfül

19.05.2016 12:40:30

Jens

Hallo an Euch,
die Lösung von Piet funktioniert ist aber aufgrund des Tabellenumfanges (20.000 Zeilen) zu langsam. Ich habe nun eine Lösung in Anlehnung an Daniels Vorschlag.

Sub Datum
Application.ScreenUpdating = False
Sheets("Hilfstabelle").Select
With ActiveSheet.UsedRange
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = "=IF(AND(RC6Hilfsblatt1!R15C5,RC7Hilfsblatt1!R15C5),0,Row())"
.Cells(1, 1).Value = 0
End With
End With
ActiveSheet.Range("A2:M" & Cells(Rows.Count, 1).End(xlUp).Row).RemoveDuplicates Columns:=13,  _
Header:=xlYes
Range("M:M").Delete
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

Löschen mehrerer Zeilen wenn Bedingung nicht erfül

Forumthread: Löschen mehrerer Zeilen wenn Bedingung nicht erfül

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Löschen mehrerer Zeilen wenn Bedingung nicht erfül

Forumthread: Löschen mehrerer Zeilen wenn Bedingung nicht erfül

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread