Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1276to1280
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Kriteriumsuche + nächsten 3 Zeilen löschen

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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
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 »

Anzeige
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 »

Anzeige
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 »

Anzeige
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!

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige