Hallo VBA-Forum,

derzeit arbeite ich an einem Projekt, bei dem man in einer Suche nach folgenden Begriffen suchen kann:

-Name

-Oberthema

-Unterthema

-Ansprechpartner

-Kontaktmöglichkeit

-Erklärungen

-ID

Das funktioniert auch alles super. Man kann neue Namen usw. per Makro hinzufügen.

Meine neuste Funktion, ist das Löschen eines Namen. Jedem Namen sind OT, UT usw zugeordnet. Wenn man also einen Namen löscht, sollen auch alle anderen zugeordneten Daten entfernt werden.

Dazu habe ich ein Skript, das auch in sich funktioniert. Aber halt auch nicht ganz. Da das Projekt sensibele Daten enthält habe ich eine zweite Datei erstellt in der nur der Teil des Makros drin ist, wo der Fehler liegt.

Das Makro sucht auf einem Tabellenblatt (Tabelle2)  nach dem Namen der gelöscht werden soll. Unter den Zellen des Namen stehen die Oberthemen die dem Namen zugeordnet sind. Eine Loop beginnt. Das erste Oberthema wird ausgewählt und als Suchvariabel abgespeichert. In diesem Loop beginnt ein zweiter Loop, der auf die Tabelle geht in der die "Rohdaten" sind.

Diese Tabelle ist wie folgt aufgebaut:

Oberthema, Unterthema, Ansprechpartner, Kontaktmöglichkeit, Erklärungen, ID

Das Oberthema wird gefunden und die ID gespeichert. Das Oberthema wird gelöscht. Der Loop geht auf die Tabelle mit den IDs und löscht die ID.
Dann wird das nächste Oberthema mit dem gleichen Namen gesucht und gelöscht.

Wenn alle Oberthemen mit dem gleichen Namen, wie in der Tabelle2 ausgewählt, gelöscht wurden geht das Makro in den ersten Loop zurück und wählt auf der Tabelle2 per Offset(1,0) das nächste Oberthema aus.

Dann geht es immer so weiter bis in der Tabelle2 eine Zelle ausgewählt ist die ="" ist.

Wie gesagt an sich funktioniert das alles perfekt, nur das manche Einträge einfach ausgelassen werden. Dieses Problem treibt mich in den Wahnsinn. Ihr könnt euch gerne selbst überzeugen:

[URL=https://www.file-upload.net/download-12843535/TestM-Kopie.xlsm.html]TestM-Kopie.xlsm[/URL]

Falls Ihr lieber nichts von fremden Menschen aus dem Internet runterladen wollt, hier der Code:

Sub Test()

Dim DelKol As String
    
     'Der User wählt in einem UserForm Person aus, die gelöscht werden soll
     
    DelKol = "Arnold"
'Der User hat Arnold ausgewählt


    Sheets("Tabelle2").Select
    
    Dim DelOTdel As Range
    
    For Each DelOTdel In Range("C2:Z2")
    If DelOTdel.Value Like DelKol Then Range(DelOTdel, DelOTdel).Select
    Next
    
    Dim k5 As Integer   'check Variable
    
    
    Dim zul1 As String
    Dim wks2 As Worksheet, Wert, Zelle As Range, Nach As Range
   
    
    Set wks2 = Worksheets("Tabelle1")
    Dim spalteE As String 'Zweite Löschpositiion
    Dim spalteA As String 'Erste Löschposition
    With wks2.Range("A:A")
    Dim lZeileOTUTdel2 As Long
    Dim IDdel As String 'ID die gelöscht werden soll
    
    'findet alle OT des Kollegen in Rohdaten tbl
    
Do

    Sheets("Tabelle2").Select
    
    ActiveCell.Offset(1, 0).Select
    If ActiveCell.Value = "" Then 'Check ob Ende der OT erreicht ist
    k5 = 1
    
    GoTo LblStop
    Else
    k5 = 0
    
    End If
    
    Wert = ActiveCell.Value 'gesuchter Wert
    Set Zelle = .Find(What:=Wert, LookIn:=xlValues, LookAt:=xlWhole)

    Do Until Zelle Is Nothing
    
    
    
    Sheets("Tabelle1").Select
    
      Set Nach = Zelle.Offset(1, 0)
      Zelle.Select
      spalteA = Selection.Address
      ActiveCell.Offset(0, 5).Select
      IDdel = ActiveCell.Value
      spalteE = Selection.Address
      

 
      wks2.Range(spalteA, spalteE).Select
      Selection.ClearContents
        
       
      Set Zelle = .FindNext(After:=Nach)
      Sheets("Tabelle3").Select
      Columns("A:A").Select
    Selection.Find(What:=IDdel, LookIn:=xlValues, LookAt:=xlWhole).Delete Shift:=xlUp
      
    Loop
LblStop:
    
    Loop Until k5 = 1
    
    
    
    End With
    
    Sheets("Tabelle1").Select
    
    lZeileOTUTdel2 = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    Range("A1:F999").Select
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle1").Sort
        .SetRange Range(Cells(2, "A"), Cells(lZeileOTUTdel2, "F"))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub

Ich hoffe hier kann mir jemand helfen. Ich verstehe nicht warum einfach manche Einträge nicht gelöscht werden.

Noch mal ein Beispiel:

Tabelle2:

Finde "Arnold" in Zeile 2. Wähle Fundort aus.

Do

Gehe eine Zeile nach unten.
Suchwert=Zelleninhalt

Wenn Suchwert ="" beende Loop

Sonst

Finde Suchwert auf Tabelle1

Sagen wir Suchwert ist der Wert "A"

Das wäre eine Besipieltabelle:

[IMG]https://www2.pic-upload.de/thumb/34396357/01-12-201710-09-06-Kopie.png[/IMG][/URL]

Das Makro sucht alle A in der Liste, speichert die ID, löscht die Zeile und geht auf Tabelle 3 und löscht die ID.

Das Problem ist jetzt das er einfach manche "A"s einfach nicht löscht und trotzdem auf Tabelle2 zum nächsten Wert geht.

Ich hoffe einer kann mir helfen.

Vielen Dank

Gordon

P.S. Ich hoffe es ist erlaubt Links zu Posten. Falls nicht tut es mir leid.