Liste von Begriffen in anderer Tabelle löschen
01.12.2017 10:28:10
Begriffen
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 (siehe angehangene Datei)
________________________________________
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:
https://www2.pic-upload.de/thumb/34396357/01-12-201710-09-06-Kopie.png
________________________________________
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
https://www.herber.de/bbs/user/118033.xlsm