Zeilen nach mehren Kriterien löschen

Forumthread: Zeilen nach mehren Kriterien löschen

08.10.2020 08:54:14

Werner

Guten Morgen,
ich verzweifle gerade an einer Aufgabe Zeilen aus einer Tabelle zu löschen die bestimmten Kriterien nicht entsprechen. Hier hat bestimmt jemand eine Idee.
Die erste Spalte der Tabelle enthält Ziffern zwischen 1 und 5 in zufälliger Reihenfolge. Die zweite Spalte den Wert rot, blau ober -. Ich möchte alle Zeilen löschen, die nicht den folgenden Kriterien entsprechen.
Spalte A: Wert 5 und Spalte B: blau oder rot.
Spalte A: Wert 4 und eine Zeile darunter Spalte A Wert 5 und Spalte B (auch Zeile darunter) Wert rot oder blau.
Spalte A: Wert 3 und zwei Zeilen darunter Spalte A Wert 5 und Spalte B Wert rot oder blau.
Spalte A: Wert 2 und drei Zeilen darunter Spalte A Wert 5 und Spalte B Wert rot oder blau.
Beispieldatei:
https://www.herber.de/bbs/user/140723.xlsx
Für eine Hilfestellung wäre ich sehr dankbar.
Grüße
Werner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zeilen nach mehren Kriterien löschen

08.10.2020 09:23:47

Rudi

Hallo,
C2: =(A2=5)*((B2="blau")+(B2="rot"))+(A2=4)*((B3="blau")+(B3="rot"))+(A2=3)*((B4="blau")+(B4="rot"))+(A2=2)*((B5="blau")+(B5="rot"))
nach 1 filtern und die Zeilen löschen.
Gruß
Rudi

AW: Zeilen nach mehren Kriterien löschen

08.10.2020 10:52:39

Werner

Danke. Super. Ich habe leider ein weiteres Kriterium vergessen, aber mit dem Lösungsvorschlag sollte ich es hinbekommen.
Vielen Dank.
Gruß
Werner

AW: Zeilen nach mehren Kriterien löschen

08.10.2020 09:53:05

UweD

Hallo
warum die erste Zeile stehen bleiben soll ist mir nicht ersichtlich.
In ein Modul:


Sub Kill_rows()
Dim LR As Long, i As Long, SP As Integer, Z1 As Integer
Dim SpTmp As Integer
SP = 1 'Daten in Spalte A
Z1 = 2 'Daten ab Zeile xx
With Sheets("Tabelle1")
LR = .Cells(.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
SpTmp = .Cells.SpecialCells(xlCellTypeLastCell).Column + 1 'erste freie Spalte des  _
gesamten Blattes
For i = Z1 To LR
Select Case .Cells(i, SP)
Case 5
If .Cells(i, SP + 1) = "blau" Or .Cells(i, SP + 1) = "rot" Then
.Cells(i, SpTmp) = 1 'bleibt
End If
Case 4
If .Cells(i + 1, SP) = 5 And (.Cells(i + 1, SP + 1) = "blau" Or .Cells(i +  _
1, SP + 1) = "rot") Then
.Cells(i, SpTmp) = 1 'bleibt
End If
Case 3
If .Cells(i + 2, SP) = 5 And (.Cells(i + 2, SP + 1) = "blau" Or .Cells(i +  _
2, SP + 1) = "rot") Then
.Cells(i, SpTmp) = 1 'bleibt
End If
Case 2
If .Cells(i + 3, SP) = 5 And (.Cells(i + 3, SP + 1) = "blau" Or .Cells(i +  _
3, SP + 1) = "rot") Then
.Cells(i, SpTmp) = 1 'bleibt
End If
End Select
Next
.Cells(1, SpTmp) = "TMP"
If WorksheetFunction.CountBlank(.Cells(Z1, SpTmp).Resize(LR - Z1 + 1, 1)) > 0 Then
.Columns(SpTmp).AutoFilter Field:=1, Criteria1:="="
.Rows(Z1).Resize(LR - Z1 + 1).Delete Shift:=xlUp
End If
.Columns(SpTmp).Delete
End With
End Sub>/pre>
LG UweD

AW: Noch ein Gedicht

08.10.2020 10:16:11

Gerd

Moin

Sub Unit()
Dim lngZeile As Long, lngZeile2 As Long, rngDel As Range
Set rngDel = Rows(Rows.Count)
For lngZeile = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
lngZeile2 = lngZeile + 5 - Cells(lngZeile, 1).Value
Select Case Cells(lngZeile, 1).Value
Case 2 To 5
Select Case Cells(lngZeile2, 2).Value
Case "blau", "rot"
Case Else: Set rngDel = Union(rngDel, Rows(lngZeile))
End Select
Case Else: Set rngDel = Union(rngDel, Rows(lngZeile))
End Select
Next
rngDel.Delete
Set rngDel = Nothing
End Sub

Gruß Gerd

OT: Spekulierst Du auf den Literatur-Nobelpreis?

08.10.2020 18:50:20

Luc:?

Dieses Mal war's ja auch 'ne (kaum bekannte) Lyrikerin… ;-]
Gruß, Luc :-?

Beliebteste Forumthreads (12 Monate)

Zeilen nach mehren Kriterien löschen

Forumthread: Zeilen nach mehren Kriterien löschen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread