"erledigt" und "x" löschen

Hallo Freunde,
ich habe ein spezifisches Anwenderproblem. Ich weis es wird nicht so gern gesehen, vll. kann mir doch jmd weiterhelfen.
Ich beschreibe mal kurz das Code-Problem, in der Bsp. Datei wird es deutlicher:
https://www.herber.de/bbs/user/108647.xlsm
mit Klick auf Button "Tabellenblatt bereinigen" fragt es den Anwender zunächst , welche der 3 Tabellen er bereinigt haben möchte.
Nach erfolgreicher Auswahl soll es mir aus der gewählten Tabelle die Zeilen löschen, die status "erledigt" bzw. "x" in der dafür vorgesehenen Zelle gepflegt haben.
Mit Tabelle "Tagesaufgaben" haut das soweit alles schick hin (richtig programmiert). Jedoch habe ich meine Programmierprobleme bei Tabelle "Problemspeicher "und Tabelle "aus Themenspeicher übertragen"
Kann mir wer mit den Code auf die Sprünge helfen?
Mein nicht funktionierender Vorschlag ist in der Bsp. Datei verarbeitet. Es müsste also ledeglich korrekturlese betrieben werden.
Danke vielmals und guten Start ins Wochenende.
Berndt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Bernd() Dim WS As Worksheet Dim rng As Range Set WS = ActiveSheet With WS.UsedRange Do Set rng = .Find("erledigt", , xlValues, xlWhole) If Not rng Is Nothing Then Rows(rng.Row).EntireRow.Delete End If Loop Until rng Is Nothing Do Set rng = .Find("x", , xlValues, xlWhole) If Not rng Is Nothing Then Rows(rng.Row).EntireRow.Delete End If Loop Until rng Is Nothing End With End Sub

Hallo,
vielen Dank für deine Antwort.
Allerdings unterscheidet dein Code nicht nach den Tabellen "Problemspeicher " und "aus Themenspeicher übertragen". In beiden können "x" stehen. Mit deinem Code würde ich die 2 Tabellen zusammen betrachten.
Hier mein nicht funktionierender Codevorschlag:

Private Sub CommandButton1_Click()
'erledigt löschen
Dim i As Long
Dim lbMsg As Byte
Dim Woloesch As String
Application.ScreenUpdating = False
Set WS = Worksheets("Herr A")
Woloesch = InputBox("(A)ufgaben" & vbLf & "(P)roblemspeicher" & vbLf & "(T)hemenspeicher", " _
Was möchten sie bereinigen?", "A")
Select Case UCase(Woloesch)
Case "A"
For i = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1
If Cells(i, 3) = "erledigt" Then Rows(i).Delete
Next i
Case "P"
With WS
With .Range("B:B")
FindStr = "Problemspeicher"
Set c = .Find(FindStr, LookIn:=xlValues)
If Not c Is Nothing Then
maxZell = .Cells(.Rows.Count, 2).End(xlUp).Row - c.Offset(1, 0).Row + 1
If maxZell  0 Then
Set Rng = .Range(c.Offset(1, -1), c.Offset(maxZell, -1))
For Each Zell In Rng
If Cells(Zell, 1) = "x" Then Rows(i).Delete
Next
End If
End If
End With
End With
Case "T"
With WS
With .Range("B:B")
FindStr = "aus Themenspeicher übertragen"
Set c = .Find(FindStr, LookIn:=xlValues)
If Not c Is Nothing Then
maxZell = .Cells(.Rows.Count, 2).End(xlUp).Row - c.Offset(1, 0).Row + 1
If maxZell  0 Then
Set Rng = .Range(c.Offset(1, -1), c.Offset(maxZell, -1))
For Each Zell In Rng
If Cells(Zell, 1) = "x" Then Rows(i).Delete
Next
End If
End If
End With
End With
End Select
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton1_Click() Dim Bereich As Range Dim Woloesch As String Woloesch = InputBox("(A)ufgaben" & vbLf & "(P)roblemspeicher" & vbLf & "(T)hemenspeicher", "Was _ möchten sie bereinigen?", "A") With ActiveSheet Select Case Woloesch Case "A": Set Bereich = Cells.Find(what:=" Tagesaufgaben ", lookat:=xlPart). _ CurrentRegion Case "P": Set Bereich = Cells.Find(what:="Problemspeicher ", lookat:=xlWhole). _ CurrentRegion Case "T": Set Bereich = Cells.Find(what:=" Themenspeicher ", lookat:=xlPart). _ CurrentRegion Case Else: Exit Sub End Select End With With Bereich .Replace "erledigt", True, xlWhole .Replace "x", True, xlWhole If WorksheetFunction.CountIf(Bereich, True) > 0 Then .SpecialCells(xlCellTypeConstants, 4). _ EntireRow.Delete End With End Sub

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

"erledigt" und "x" löschen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread