Beiträge zum Thread: Zeilen löschen verhindern ohne Blattschutz

du musst, wenn eine Zelle gelöscht wurde, ein Rückgängig ausführen:

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Me.UsedRange) Is Nothing Then

    Application.EnableEvents = False

    Application.Undo

    Application.EnableEvents = True

    MsgBox "Bitte keine Zeilen löschen, nur leeren"

End If

End Sub

Gruß Daniel

hab da nochmal getestet und es funktioniert nicht

daher besser auf diese weise prüfen, ob Zellen gelöscht oder eingefügt wurden:

Option Explicit

Dim Zellen As Range



Private Sub Worksheet_Change(ByVal Target As Range)

Dim x As String

On Error Resume Next

x = Zellen.Address

On Error GoTo 0

If x = Target.Address Then

    '--- normale Änderung

ElseIf x = "" Then

    '--- Zellen wurden gelöscht

    Application.EnableEvents = False

    Application.Undo

    Application.EnableEvents = True

    MsgBox "Bitte keine Zellen löschen, nur leeren"

ElseIf x <> Target.Address Then

    '--- Zellen wurden eingefügt

    Application.EnableEvents = False

    Application.Undo

    Application.EnableEvents = True

    MsgBox "Bitte keine Zellen einfügen"

End If

End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Set Zellen = Target

End Sub

Gruß Daniel

Hi,

Gute Idee @Daniel. Dein erster Code funktioniert schon, aber leider nur mit der letzten Zeile. Darauf aufbauend würde ich es so machen:

Dim urrc As Long



Private Sub Worksheet_Activate()

  urrc = Me.UsedRange.Rows.Count

End Sub



Private Sub Worksheet_Change(ByVal Target As Range)

If Me.UsedRange.Rows.Count < urrc Then

    Application.EnableEvents = False

    Application.Undo

    Application.EnableEvents = True

    MsgBox "Bitte keine Zeilen löschen, nur leeren"

End If

End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  urrc = Me.UsedRange.Rows.Count

End Sub

Gruß Mr. K.

Hallo und schon vielen Dank,

der Tipp von Mr. K. funktioniert wunderbar, wenn nur dieses eine Makro im Tabellenblatt vorhanden ist. Doch es gibt noch Makro, in dem die Zeile "Private Sub Worksheet_Change(ByVal Target As Range)" vorkommt.

'================================================================================

' Worksheet_Change: Reagiert auf Änderungen in der Tabelle

'================================================================================

Private Sub Worksheet_Change(ByVal Target As Range)

    

    ' Bereich A4:A93 – Buchungsart prüfen

    If Not Intersect(Target, Me.Range("A4:A93")) Is Nothing Then

        Call Buchungsart_Geändert(Target)

    

    ' Bereich B4:B93 – Datum prüfen und konvertieren

    ElseIf Not Intersect(Target, Me.Range("B4:B93")) Is Nothing Then

        Call DatumKonvertieren(Target)

    

    ' Bereich C3:C93 – Formel wiederherstellen falls gelöscht

    ElseIf Not Intersect(Target, Me.Range("C3:C93")) Is Nothing Then

        

        ' Nur bei Einzelzellen-Auswahl reagieren

        If Target.Cells.CountLarge = 1 Then

            If Target.Value = "" Then

                Application.EnableEvents = False

                On Error Resume Next

                If Target.Row = 3 Then

                    Target.Value = 0

                Else

                    Target.Formula = "=J" & Target.Row

                End If

                On Error GoTo 0

                Application.EnableEvents = True

            End If

        End If

    End If



End Sub

Ich denke, dass hier die beiden Anweisungen kollidieren und es deshalb nicht läuft. Vielleicht findet ihr ja auch dafür eine Lösung. Die Tabelle ist die "Tabelle1".

Dank

Andreas

Es kann natürlich nur ein Worksheet_Change-Makro pro Tabellenblatt geben. In dem Fall muss du halt beide Makros zusammenführen. Ändere mal das Worksheet_Change-Makro wie folgt:

Private Sub Worksheet_Change(ByVal Target As Range)

    

    If Me.UsedRange.Rows.Count < urrc Then

      Application.EnableEvents = False

      Application.Undo

      Application.EnableEvents = True

      MsgBox "Bitte keine Zeilen löschen, nur leeren"

    

    ' Bereich A4:A93 – Buchungsart prüfen

    ElseIf Not Intersect(Target, Me.Range("A4:A93")) Is Nothing Then

        Call Buchungsart_Geändert(Target)

    

    ' Bereich B4:B93 – Datum prüfen und konvertieren

    ElseIf Not Intersect(Target, Me.Range("B4:B93")) Is Nothing Then

        Call DatumKonvertieren(Target)

    

    ' Bereich C3:C93 – Formel wiederherstellen falls gelöscht

    ElseIf Not Intersect(Target, Me.Range("C3:C93")) Is Nothing Then

        

        ' Nur bei Einzelzellen-Auswahl reagieren

        If Target.Cells.CountLarge = 1 Then

            If Target.Value = "" Then

                Application.EnableEvents = False

                On Error Resume Next

                If Target.Row = 3 Then

                    Target.Value = 0

                Else

                    Target.Formula = "=J" & Target.Row

                End If

                On Error GoTo 0

                Application.EnableEvents = True

            End If

        End If

    End If



End Sub

Vergiss aber nicht, auch die anderen Codeteile des letzten Beitrags zu übernehmen.
Gruß Mr. K.

Hallo,

danke noch einmal für die Mühe. Aber es funktioniert leider nicht. Beim Versuch eine Zeile zu löschen, wird in der zweiten Zeile des Codes "urrc" blau markiert und es erscheint die Meldung: "Fehler beim Kompilieren: Variable nicht definiert". In der vorhergehenden Version war noch als zweite Zeile die Zeile "urrc = Me.UsedRange.Rows.Count" vorhanden. Auch damit erhalte ich die selbe Meldung. In jedem Fall ist die zu schützende Zeile dann doch gelöscht. Der Bezug zu den folgenden Zeilen ist dann auch nicht mehr gegeben.
Vielleicht gibt es ja doch noch eine Lösung.

Danke

Andreas

tja, ist jetzt schwer zu sagen, was du falsch gemacht hast, wenn du uns nichts zeigt, was du gemacht hast.
also bitte Code posten oder noch besser, die Datei hochladen.
Dann können wir draufschauen, wo dein Fehler liegt.

die Frage ist, wo ist denn wichtig, dass der Bezug nicht verloren geht?
hast du bezüge auf die Zeile drüber oder darunter, also in A2 den Bezug auf A1?
dann könntest du auch das =A1 durch =Index(A:A;Zeile()-1) ersetzen.
wenn du so eine Zeile löschst, dann referenziert die Formel automatisch auf die neue darüber liegende Zeile und der Bezug geht nicht verloren (außer bei der Zeile 1, aber das ist ja auch nicht anders zu erwarten)

Gruß Daniel

Guten Abend,

ich hatte doch geschrieben, dass du auch die anderen Codeteile aus dem vorherigen Code übernehmen sollst. Ich kann nicht wissen, was du sonst noch an Code in dem Blatt hast. Daher nimm den vorherigen Code, ersetze das Worksheet_Change_Makro durch den neuen Code und ergänze das Ganze mit deinen anderen Codes. Hier nochmal der aktuell bekannte Code in Komplettform. Wichtig dabei ist, dass die Deklaration der Variable urrc ganz oben als erste Zeile im Blatt-Modul steht.

Dim urrc As Long



Private Sub Worksheet_Activate()

  urrc = Me.UsedRange.Rows.Count

End Sub



Private Sub Worksheet_Change(ByVal Target As Range)

    

    If Me.UsedRange.Rows.Count < urrc Then

      Application.EnableEvents = False

      Application.Undo

      Application.EnableEvents = True

      MsgBox "Bitte keine Zeilen löschen, nur leeren"

    

    ' Bereich A4:A93 – Buchungsart prüfen

    ElseIf Not Intersect(Target, Me.Range("A4:A93")) Is Nothing Then

        Call Buchungsart_Geändert(Target)

    

    ' Bereich B4:B93 – Datum prüfen und konvertieren

    ElseIf Not Intersect(Target, Me.Range("B4:B93")) Is Nothing Then

        Call DatumKonvertieren(Target)

    

    ' Bereich C3:C93 – Formel wiederherstellen falls gelöscht

    ElseIf Not Intersect(Target, Me.Range("C3:C93")) Is Nothing Then

        

        ' Nur bei Einzelzellen-Auswahl reagieren

        If Target.Cells.CountLarge = 1 Then

            If Target.Value = "" Then

                Application.EnableEvents = False

                On Error Resume Next

                If Target.Row = 3 Then

                    Target.Value = 0

                Else

                    Target.Formula = "=J" & Target.Row

                End If

                On Error GoTo 0

                Application.EnableEvents = True

            End If

        End If

    End If



End Sub





Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  urrc = Me.UsedRange.Rows.Count

End Sub

Gruß Mr. K.

Hallo an alle, die geholfen haben.
Ich bedanke mich innigst und bitte euch um Verzeihung. Jetzt funktioniert es wie gewünscht. Im vorletzten Tipp hat die Deklaration der Variablen "urrc" gefehlt. Dies war der Fehler. Jetzt können sich unsere Kassierer die Tabellen nicht mehr "zerschießen". Ich bin euch unendlich dankbar.

Viele Grüße

Andreas