Bestimmte Zeilen entfernen per Messenger Eingabe

[Stefan87]

Hallo zusammen

Ich habe folgenden Code für bestimmte Texte zu entfernen:

Code:

Option Explicit
Const Titel = "Nicht benötigte Artikel"
Const Msg = "Welche BMK werden nicht benötigt?"
   
Sub Artikel_entfernen_BMK()
    Dim i As Long          ' Zeilenzähler
    Dim tofind As Variant  ' Hiernach wird gesucht
    Dim found As Range      ' Eine Fundstelle oder Nothing
    tofind = InputBox(prompt:=Msg, Title:=Titel)
    If tofind = "" Then Exit Sub
    Application.ScreenUpdating = False
    For i = Worksheets("Erzeugte BMK").Cells.SpecialCells(xlCellTypeLastCell).Row _
        To 1 Step -1
        Set found = Worksheets("Erzeugte BMK").Rows(i).Find(what:=tofind, _
        LookIn:=xlValues, lookat:=xlWhole)
            If Not found Is Nothing Then Worksheets("Erzeugte BMK").Rows(i).Delete
    Next
    Application.ScreenUpdating = True
End Sub

Wie müsste ich den Code ändern, um anzugeben, welche Zeilen ist entfernt haben möchte? z.Bsp. Zeile 100-102 oder Zeile 35

[Egon12]

Hallo,

da nicht ganz klar ist was du willst, habe ich erst mal eine Löschasabfrage eingebaut.

Beispiel:

Code:

Sub Artikel_entfernen_BMK()
    Dim i As Long          ' Zeilenzähler
    Dim tofind As Variant  ' Hiernach wird gesucht
    Dim found As Range      ' Eine Fundstelle oder Nothing
    tofind = InputBox(prompt:=Msg, Title:=Titel)
    If tofind = "" Then Exit Sub
    Application.ScreenUpdating = False
    For i = Worksheets("Erzeugte BMK").Cells.SpecialCells(xlCellTypeLastCell).Row _
        To 1 Step -1
        Set found = Worksheets("Erzeugte BMK").Rows(i).Find(what:=tofind, _
        LookIn:=xlValues, lookat:=xlWhole)
            If Not found Is Nothing Then
                If MsgBox("Die Zeile " & i & " soll gelöscht werden?", vbQuestion + vbYesNo, "Abfrage löschen") = vbYes Then
                    Worksheets("Erzeugte BMK").Rows(i).Delete
                End If
            End If
    Next
    Application.ScreenUpdating = True
End Sub

Ausgabe welche Zeilen gelöscht worden sind, dann so:

Code:

Sub Artikel_entfernen_BMK()
    Dim i As Long          ' Zeilenzähler
    Dim tofind As Variant  ' Hiernach wird gesucht
    Dim found As Range      ' Eine Fundstelle oder Nothing
    Dim varDelZeilen As String
    tofind = InputBox(prompt:=Msg, Title:=Titel)
    If tofind = "" Then Exit Sub
    Application.ScreenUpdating = False
    For i = Worksheets("Erzeugte BMK").Cells.SpecialCells(xlCellTypeLastCell).Row _
        To 1 Step -1
        Set found = Worksheets("Erzeugte BMK").Rows(i).Find(what:=tofind, _
        LookIn:=xlValues, lookat:=xlWhole)
            If Not found Is Nothing Then
                Worksheets("Erzeugte BMK").Rows(i).Delete
                varDelZeilen = varDelZeilen & " " & i & ","
            End If
    Next
    Application.ScreenUpdating = True
    MsgBox "gelöschte Zeilen " & varDelZeilen
End Sub

Gruß Uwe