Kriteriumsuche + nächsten 3 Zeilen löschen

Forumthread: Kriteriumsuche + nächsten 3 Zeilen löschen

Lutz

Guten Abend zusammen,
ich benötige mal wieder euere Hilfe.
Ich möchte eine Spalte (z.B.: Spalte B) nach einem Kriterium (z.B.: alle Wörter die mit S anfangen) durchsuchen und dann sollen die nächsten 3 Zeilen darunter gelöscht werden (aber nicht die Zeile in der das Kriterium steht).
Also im Sinne von Suche in Sppalte B nach "S*" und lösche die nächsten 3 Zeilen darunter.
Hat irgendjemand eine Idee wie man das umsetzen könnte?
Vielen lieben Dank und einen schönen Abend noch!
Gruß Lutz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Kriteriumsuche + nächsten 3 Zeilen löschen

22.08.2012 18:29:43

Josef

Hallo Lutz,

Sub lutz()
  Dim rng As Range, rngDel As Range
  Dim strFirst As String
  
  Const clngColumn As Long = 2 'Spalte B
  
  With ActiveSheet 'oder Sheets("Tabelle1")
    Set rng = .Columns(clngColumn).Find(What:="s*", LookIn:=xlWhole, LookAt:=xlValues, _
      MatchCase:=False, After:=.Cells(1, clngColumn))
    
    If Not rng Is Nothing Then
      strFirst = rng.Address
      Do
        If rngDel Is Nothing Then
          Set rngDel = rng.Offset(1, 0).Resize(3, 1).EntireRow
        Else
          Set rngDel = Union(rngDel, rng.Offset(1, 0).Resize(3, 1).EntireRow)
        End If
      Loop While Not rng Is Nothing And strFirst <> rng.Address
    End If
  End With
  
  If Not rngDel Is Nothing Then rngDel.Delete
  
  Set rng = Nothing
  Set rngDel = Nothing
End Sub

« Gruß Sepp »

Korrektur!

22.08.2012 18:31:03

Josef

Hallo nochmal,
.FindNext vergessen ;-))

Sub lutz()
  Dim rng As Range, rngDel As Range
  Dim strFirst As String
  
  Const clngColumn As Long = 2 'Spalte B
  
  With ActiveSheet 'oder Sheets("Tabelle1")
    Set rng = .Columns(clngColumn).Find(What:="s*", LookIn:=xlWhole, LookAt:=xlValues, _
      MatchCase:=False, After:=.Cells(1, clngColumn))
    
    If Not rng Is Nothing Then
      strFirst = rng.Address
      Do
        If rngDel Is Nothing Then
          Set rngDel = rng.Offset(1, 0).Resize(3, 1).EntireRow
        Else
          Set rngDel = Union(rngDel, rng.Offset(1, 0).Resize(3, 1).EntireRow)
        End If
        Set rng = .Columns(clngColumn).FindNext(rng)
      Loop While Not rng Is Nothing And strFirst <> rng.Address
    End If
  End With
  
  If Not rngDel Is Nothing Then rngDel.Delete
  
  Set rng = Nothing
  Set rngDel = Nothing
End Sub

« Gruß Sepp »

AW: Korrektur!

22.08.2012 18:38:32

Lutz

Hallo Sepp,
vielen Dank für deine Antwort.
Excel sagt mir aber bei:
Set rng = .Columns(clngColumn).Find(What:="s*", LookIn:=xlWhole, LookAt:=xlValues, _
MatchCase:=False, After:=.Cells(1, clngColumn))
Das es sich um den Laufzeitfehler 9 handelt und sich der Index sich außerhalb des gültigen Bereichs befindet.
Hab ich irgendwas übersehen?
Gruß Lutz

AW: Korrektur!

22.08.2012 19:30:29

Josef

Hallo Lutz,
hab ich doch glatt zwei Parameter verwechselt.

Sub lutz()
  Dim rng As Range, rngDel As Range
  Dim strFirst As String
  
  Const clngColumn As Long = 2 'Spalte B
  
  With ActiveSheet 'oder Sheets("Tabelle1")
    Set rng = .Columns(clngColumn).Find(What:="s*", LookIn:=xlValues, LookAt:=xlWhole, _
      MatchCase:=False, After:=.Cells(1, clngColumn))
    
    If Not rng Is Nothing Then
      strFirst = rng.Address
      Do
        If rngDel Is Nothing Then
          Set rngDel = rng.Offset(1, 0).Resize(3, 1).EntireRow
        Else
          Set rngDel = Union(rngDel, rng.Offset(1, 0).Resize(3, 1).EntireRow)
        End If
        Set rng = .Columns(clngColumn).FindNext(rng)
      Loop While Not rng Is Nothing And strFirst <> rng.Address
    End If
  End With
  
  If Not rngDel Is Nothing Then rngDel.Delete
  
  Set rng = Nothing
  Set rngDel = Nothing
End Sub

« Gruß Sepp »

AW: Kriteriumsuche + nächsten 3 Zeilen löschen

22.08.2012 18:31:20

Rudi

Hallo,
Löschcodes gibt's zuhauf, u.a. ein paar Threads tiefer.

Sub Loeschen()
Dim rng As Range, rngDelete As Range
For Each rng In Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp))
If rng Like "S*" Then
If rngDelete Is Nothing Then
Set rngDelete = rng.Offset(1).Resize(3)
Else
Set rngDelete = Union(rngDelete, rng.Offset(1).Resize(3))
End If
End If
Next
If Not rngDelete Is Nothing Then rngDelete.EntireRow.Delete
End Sub

Gruß
Rudi

AW: Kriteriumsuche + nächsten 3 Zeilen löschen

22.08.2012 18:50:54

Lutz

Vielen Dank, funktioniert 1a!

Beliebteste Forumthreads (12 Monate)

Kriteriumsuche + nächsten 3 Zeilen löschen

Forumthread: Kriteriumsuche + nächsten 3 Zeilen löschen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Kriteriumsuche + nächsten 3 Zeilen löschen

Forumthread: Kriteriumsuche + nächsten 3 Zeilen löschen

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