Microsoft Excel

Herbers Excel/VBA-Archiv

zeilen lsöchen wenn bestimmte Konstellation

Betrifft: zeilen lsöchen wenn bestimmte Konstellation von: Andreas
Geschrieben am: 08.08.2014 16:11:29

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


  

Betrifft: AW: zeilen lsöchen wenn bestimmte Konstellation von: Daniel
Geschrieben am: 08.08.2014 16:36:37

Hi

kannst du bitte die Datei hochladen und die Zeilen farbig markieren, die gelöscht werden müssen?
Deine Beschreibung ist auch nicht ganz eindeutig, erst soll in R und Q auf eine Differenz geprüft werden, dann wieder die Summe...
da solltest du vielleicht nochmal über die Aufgabenstellung nachdenken und diese etwas präziser beschreiben.

Gruß Daniel


  

Betrifft: AW: zeilen lsöchen wenn bestimmte Konstellation von: Andreas
Geschrieben am: 08.08.2014 18:30:15

Hallo Daniel,

die Datei habe ich hochgeladen- 91980.xls
Die Berechung R und Q ist quasi die Summenzeile.

Gruss
Andreas


  

Betrifft: wo ist die Datei? von: robert
Geschrieben am: 08.08.2014 18:58:51

die Datei habe ich hochgeladen- 91980.xls

Gruß
robert


  

Betrifft: AW: wo ist die Datei? von: Andreas
Geschrieben am: 08.08.2014 19:03:09

Hallo,
unter
https://www.herber.de/bbs/user/91980.xls
ist die Datei zu finden.
Ich habe die Datei normal hochgeladen.

Gruss
Andreas


  

Betrifft: AW: wo ist die Datei? von: Dieter Klemke
Geschrieben am: 08.08.2014 21:46:18

Hallo Robert,

du könntest das mit dem folgenden Programm machen:

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
Viele Grüße
Dieter


  

Betrifft: AW: wo ist die Datei? von: Andreas
Geschrieben am: 11.08.2014 13:41:59

Hallo Dieter,

vielen Dank für deine Antwort.
Ich habe versucht, den Code ein wenig anzupassen nach folgender Logik:
Wenn C <> "", dann prüfe, ob D = "".
Wenn ja, dann prüfe, ob P = 0.
Wenn ja, dann lösche den Block.
Block ist, wenn Wert in Zeile C = Zeile C - 1 und Zeile E = E-1

Nun bekomme ich eine Laufzeitfehler 1004 in Zeile
...
zeile = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

hier mein Code:


Option Explicit

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

kannst du mir einen Tipp geben, wo hier der Fehler liegt?

Vielen Dank.

Gruss
Andreas


  

Betrifft: AW: wo ist die Datei? von: Dieter Klemke
Geschrieben am: 11.08.2014 20:54:22

Hallo Andreas (Entschuldigung, in der letzten Mail habe ich Robert geschrieben),

wenn ich deine Löschbedingung für einen Zeilenblock richtig verstanden habe, dann könnte das Programm so aussehen:

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

Falls ich dich falsch verstanden habe, wäre es am besten, wenn du noch einmal eine Datei hochladen könntest, bei der du wieder die zu löschenden Zeilenblöcke markiest.

Viele Grüße
Dieter


  

Betrifft: AW: wo ist die Datei? von: Andreas
Geschrieben am: 13.08.2014 11:48:55

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


  

Betrifft: AW: wo ist die Datei? von: Dieter Klemke
Geschrieben am: 14.08.2014 18:49:24

Hallo Andreas,

du schreibst, dass du einige Zellen einer Zeile mit der vorhergehenden Zeile vergleichen willst, vergleichst dann aber Spalten innerhalb der gleichen Zeile (If Cells(i, 3).Value = Cells(i, 3 - 1).Value And ...).

So wie ich deine Anforderung verstehe, könnte die Ergänzung folgendermaßen aussehen:

  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
Warum arbeitest du nur bis Zeile 7?
Ich kann das Programm mit deiner Beispieldatei nicht mehr testen, ggf.müsstest du eine neue Testdatei hochladen, die auch Sätze enthält, die nach dieser Ergänzung gelöscht werden sollen.

Viele Grüße
Dieter


 

Beiträge aus den Excel-Beispielen zum Thema "zeilen lsöchen wenn bestimmte Konstellation "