Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Zeilen nach mehren Kriterien löschen

nach unten

Betrifft: Zeilen nach mehren Kriterien löschen von: Werner
Geschrieben am: 08.10.2020 08:54:14

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

nach oben  nach unten

Betrifft: AW: Zeilen nach mehren Kriterien löschen
von: Rudi Maintaire
Geschrieben am: 08.10.2020 09:23:47

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

nach oben  nach unten

Betrifft: AW: Zeilen nach mehren Kriterien löschen
von: Werner
Geschrieben am: 08.10.2020 10:52:39

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

Vielen Dank.
Gruß
Werner

nach oben  nach unten

Betrifft: AW: Zeilen nach mehren Kriterien löschen
von: UweD
Geschrieben am: 08.10.2020 09:53:05

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





nach oben  nach unten

Betrifft: AW: Noch ein Gedicht





von: Gerd L

Geschrieben am: 08.10.2020 10:16:11


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





nach oben  nach unten

Betrifft: OT: Spekulierst Du auf den Literatur-Nobelpreis?





von: Luc:?

Geschrieben am: 08.10.2020 18:50:20


Dieses Mal war's ja auch 'ne (kaum bekannte) Lyrikerin… ;-]

Gruß, Luc :-?