zeilen lsöchen wenn bestimmte Konstellation

Hallo,
ich habe folgendes Problem:
Ich möchte ein Liste prüfen, ob in den Spalte R und Q eine Differenz auftritt.
Wenn ja, dann soll die Spalte C geprüft werden, ob diese mit der vorherigen übereinstimmt (ist z.b. c100 = c99 und c99=c98 usw.).
Wenn das der Fall ist, dann sollen die betreffenden Zeilen gelöscht werden, wenn nicht, dann sollen die Zeilen erhalten bleibe.
Sobald sich der Wert in Splate c ändeert, soll erneut auf die Summe geprüft werden usw.
Mit folgendem Code passt das nicht so ganz...
Kann mir einer einen Hinweis geben, wie das geschkterweise gelöst werden kann?

Sub Zeilen_loeschen()
Application.ScreenUpdating = False                       ' Bildschirmausgaben abschalten
Dim Zeile As Long
Dim i As Long
' X setzen , um die Summenzeile zu markieren
Zeile = Range("A65536").End(xlUp).Row
For i = Zeile To 2 Step -1
If Cells(i, 3).Value  "" And Cells(i, 4).Value = "" Then
Cells(i, 1) = "X"  'als Hilfsmittel für die Summenzeile
End If
Next i
'löschen der zeilen, deren Differenz Null ist (in Spalte Q und R)
'Zeile = Range("A65536").End(xlUp).Row
For i = Zeile To 2 Step -1
If Cells(i, 2).Value = "X" And Cells(i, 17).Value = Cells(i, 18).Value And Cells(i - 1, 3). _
Value = Cells(i, 3).Value Then
'If Cells(i, 1).Value = "X" Or Cells(i, 2).Value = "B" Then
Rows(i).Delete
End If
If Cells(i, 17).Value = Cells(i, 18).Value Then
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True                       ' Bildschirmausgaben einschalten
End 

Sub
Gruss
Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Zeilen_loeschen() Dim anfZeileBlock As Long Dim endZeileBlock As Long Dim ws As Worksheet Dim z As Long Dim zeile As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("Sheet1") zeile = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row Do Until zeile = 2 If Not IsEmpty(ws.Cells(zeile, "Q")) And _ ws.Cells(zeile, "Q") = ws.Cells(zeile, "R") Then endZeileBlock = zeile anfZeileBlock = endZeileBlock For z = endZeileBlock To 2 Step -1 If ws.Cells(z, "C") ws.Cells(endZeileBlock, "C") Then anfZeileBlock = z + 1 Exit For End If Next z ' Block löschen ws.Range(ws.Rows(anfZeileBlock), _ ws.Rows(endZeileBlock)).Delete zeile = anfZeileBlock - 1 Else zeile = zeile - 1 End If Loop Application.ScreenUpdating = True End Sub

Sub Zeilen_loeschenneu____________() Dim anfZeileBlock As Long Dim endZeileBlock As Long Dim ws As Worksheet Dim z As Long Dim zeile As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("Sheet1") zeile = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row Do Until zeile = 2 If Not IsEmpty(ws.Cells(zeile, "C")) Then If Not IsEmpty(ws.Cells(zeile, "D")) Then If ws.Cells(zeile, "P")) = 0 Then endZeileBlock = zeile anfZeileBlock = endZeileBlock End If End If For z = endZeileBlock To 2 Step -1 If ws.Cells(z, "C") ws.Cells(endZeileBlock, "C") And _ ws.Cells(z, "E") ws.Cells(endZeileBlock, "E") Then anfZeileBlock = z + 1 Exit For End If Next z ' Block löschen ws.Range(ws.Rows(anfZeileBlock), _ ws.Rows(endZeileBlock)).Delete zeile = anfZeileBlock - 1 Else zeile = zeile - 1 End If Loop Application.ScreenUpdating = True End Sub

Sub Zeilen_loeschen_3() Dim anfZeileBlock As Long Dim endZeileBlock As Long Dim ws As Worksheet Dim z As Long Dim zeile As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("Sheet1") zeile = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row Do Until zeile = 2 If Not IsEmpty(ws.Cells(zeile, "C")) And _ IsEmpty(ws.Cells(zeile, "D")) And _ ws.Cells(zeile, "P") = 0 Then endZeileBlock = zeile anfZeileBlock = endZeileBlock For z = endZeileBlock To 2 Step -1 If ws.Cells(z, "C") ws.Cells(endZeileBlock, "C") Or _ ws.Cells(z, "E") ws.Cells(endZeileBlock, "E") Then anfZeileBlock = z + 1 Exit For End If Next z ' Block löschen ws.Range(ws.Rows(anfZeileBlock), _ ws.Rows(endZeileBlock)).Delete zeile = anfZeileBlock - 1 Else zeile = zeile - 1 End If Loop Application.ScreenUpdating = True End Sub

Hallo Dieter,
vielen Dank für dein Hilfe- funktioniert super.
Ich wollte ans Ende des Codings noch folgende Logik einbinden (allerdings erhalte ich nicht das gewünschte Ergebnis)
' check auf Q - hier dann die Q-Zeilen X setzen
Zeileloesch = Range("C65536").End(xlUp).Row
For i = Zeileloesch To 7 Step -1
If Cells(i, 3).Value = Cells(i, 3 - 1).Value And Cells(i, 4).Value = Cells(i, 4 - 1).Value And Cells(i, 5).Value = Cells(i, 5 - 1).Value And _
Cells(i, 6).Value = Cells(i, 6 - 1).Value And Cells(i, 13).Value "Q" Then
Rows(i).Delete
End If
Next i
Hintergrund: ich will noch zusätzlich prüfen, ob die nachfolgende Zeile mit der vorherigen in bestimmten Zellen übereinstimmt (C = C-1 usw.) Wenn ja und in Spalte M ist kein "Q", dann soll diese Zeile gelöscht werden.
Kannst du mir hier noch einen Tipp geben, was ich hier falsch mache?
Gruss
Andreas

zeile = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row For z = zeile To 7 Step -1 If ws.Cells(z, "C").Value = ws.Cells(z - 1, "C").Value And _ ws.Cells(z, "D").Value = ws.Cells(z - 1, "D").Value And _ ws.Cells(z, "E").Value = ws.Cells(z - 1, "E").Value And _ ws.Cells(z, "F").Value = ws.Cells(z - 1, "F").Value And _ ws.Cells(z, "M").Value "Q" Then ws.Rows(z).Delete End If Next z

Beliebteste Forumthreads (12 Monate)

zeilen lsöchen wenn bestimmte Konstellation

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread