Weggeschriebene Kommentare löschen
28.09.2022 08:38:04
Tobias
mit großer Unterstützung vom Forumsmitglied MCO habe ich nachfolgenden Code erstellt (siehe weiter unten).
Allerdings hat sich noch eine weitere Problematik ergeben, weshalb ich eure Hilfe benötige :-).
Kurze Beschreibung der Datei:
Im Blatt "Übersicht" gibt es DropDown-Felder. So kann z.B. ein Mitarbeiter seinen Namen auswählen und erhält darunter als Liste SEINE Informationen. Die Liste enthält einige Spalten. Daneben die Spalten 14 (Kommentarspalte) sowie Spalte 15 (2te Kommentarspalte).
Nun schreibt der nachstehende Code bei Eingabe eines Kommentars in Spalte 14 oder 15 diese Kommentare weg (Spalte 14 wird in das Blatt "Kommentare" geschrieben, Spalte 15 in das Blatt "Kommentare2"). Löscht der User nun z.B. den Kommentar in einer Spalte, wird dieser auch aus dem Blatt Kommentare oder Kommentare2 entfernt. Die weggeschriebenen Kommentare werden per SVERWEIS bei Neuauswahl beim DropDown wieder in das Blatt "Übersicht" gezogen.
Soweit, so gut. Nur folgendes Problem:
Hat der User in beide Spalten einen Kommentar eingegeben und will diese ZUSAMMEN löschen, dann kommt der Laufzeitfehler 13 - Typen unverträglich.
Im Endeffekt wird der User immer versuchen alle oder mehrere Kommentare auf einmal zu löschen; dann muss er natürlich die Spalten 14 und 15 zusammen markieren können (1 Zeile oder beliebig viele) und die Inhalte mit ENTF löschen können. Das funktioniert eben aktuell nicht. Jetzt müsste er in jede einzelne Zelle und dort die Kommentare mit ENTF löschen, was natürlich unzumutbar ist. Wichtig ist natürlich auch, dass die Kommentare in den Blättern "Kommentare" und "Kommentare2" weiterhin gelöscht werden.
Hat jemand eine Idee :-)?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim gefunden As Range
Dim lz As Long
Dim komm_sh As Worksheet
Dim komm_sh2 As Worksheet
Set komm_sh = Sheets("Kommentare")
Set komm_sh2 = Sheets("Kommentare2")
'Wird im Blatt "Übersicht" in Spalte 14 ein Kommentar eingegeben, so wird dieser in das Blatt "Kommentare" geschrieben. Updates der Kommentare sind berücksichtigt.
If Target.Column = 14 And Target.Row >= 13 Then
If Cells(Target.Row, "D") = "" Then MsgBox "Die eindeutige Nummer fehlt", vbCritical + vbOKOnly, "Abbruch": Cells(Target.Row, "D").Select: Exit Sub
Set gefunden = komm_sh.Range("A:A").Find(Cells(Target.Row, "D"), lookat:=xlWhole) 'erst Kommentar finden
If Not gefunden Is Nothing Then komm_sh.Rows(gefunden.Row).Delete '+ ggf. löschen
If Target.Value "" Then
lz = komm_sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 'letzte Zeile ermitteln
Cells(Target.Row, "D").Copy komm_sh.Cells(lz, 1) 'ID-Nummer neu schreiben
Target.Copy komm_sh.Cells(lz, 2) 'Kommentar neu schreiben
End If
End If
'Wird im Blatt "Übersicht" in Spalte 15 ein Kommentar eingegeben, so wird dieser in das Blatt "Kommentare2" geschrieben. Updates der Kommentare sind berücksichtigt.
If Target.Column = 15 And Target.Row >= 13 Then
If Cells(Target.Row, "D") = "" Then MsgBox "Die eindeutige Nummer fehlt", vbCritical + vbOKOnly, "Abbruch": Cells(Target.Row, "D").Select: Exit Sub
Set gefunden = komm_sh2.Range("A:A").Find(Cells(Target.Row, "D"), lookat:=xlWhole) 'erst Kommentar finden
If Not gefunden Is Nothing Then komm_sh2.Rows(gefunden.Row).Delete '+ ggf. löschen
If Target.Value "" Then
lz = komm_sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 'letzte Zeile ermitteln
Cells(Target.Row, "D").Copy komm_sh2.Cells(lz, 1) 'ID-Nummer neu schreiben
Target.Copy komm_sh2.Cells(lz, 2) 'Kommentar neu schreiben
End If
End If
Gruß
Tobias