Löschen-Makro erweitern
15.06.2015 21:58:04
mike49
bräuchte mal wieder eure Hilfe.
Ich habe eine Mappe mit Blättern der Monate Jan bis Dez. Ein Löschen-Makro entfernt festgelegte Inhalte des aktuellen Blattes und auf Nachfrage auch Inhalte der restlichen Blätter. Es ist quasi ein Zurücksetzen. Im Bereich L9:L39 steht eine Formel, mit der die Feiertage eingetragen werden. In L9 z.B. steht die Formel:=WENN(ISTNV(INDEX($Q$10:$R$38;VERGLEICH($C9;$Q$10:$Q$38;0);2));"";INDEX($Q$10:$R$38;VERGLEICH($C9;$Q$10:$Q$38;0);2)). Für die weiteren Zellen wird immer auf das Datum in Spalte C Bezug genommen. Ich muss aber öfters die Formeln duch Einträge überschreiben. Wenn ich jetzt den Bereich L9:L39 in das Löschen-Makro integriere, werden auch die Formeln gelöscht. Das soll aber nicht so sein. Die Formeln sollen aber nach dem Löschen (=Zurücksetzen) wieder drinstehen.
Kann man das in nachfolgendes Löschen-Makro integrieren?
Option Explicit
Sub Löschen(Optional Dummy As Byte)
Dim strAntwort As String
strAntwort = MsgBox("Achtung: Das gesamte Tabellenblatt wird zurückgesetzt!", _
vbExclamation + vbOKCancel, "Hinweis")
If strAntwort = vbCancel Then Exit Sub 'Bei "Abbrechen" abbrechen.
With Application
.ScreenUpdating = False 'Bildschirmaktualisierung abschalten.
.EnableEvents = False 'Ereignissprozeduren deaktivieren.
.Calculation = xlCalculationManual
End With
With ActiveSheet
.Unprotect
.Range("E9:H39").ClearContents
.Range("F43").Value = "0"
.Range("E9").Select
.Protect
End With
strAntwort = MsgBox("Die anderen Tabellenblätter ebenfalls zurücksetzen?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Frage")
If strAntwort = vbYes Then
If ANDERE_TABELLEN = True Then
MsgBox "Alle Monate auf Null gesetzt.", vbInformation, "Information"
End If
End If
With Application
.ScreenUpdating = True 'Bildschirmaktualisierung abschalten.
.EnableEvents = True 'Ereignissprozeduren deaktivieren.
.Calculation = xlCalculationAutomatic
.ActiveWindow.ScrollRow = 8
End With
End Sub
Private Function ANDERE_TABELLEN() As Boolean
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name ActiveSheet.Name And Len(Sh.Name) = 3 Then
If TABELLE_AUF_NULL(Sh.Name) = False Then
MsgBox "Fehler bei Tabelle: " & Sh.Name, _
vbCritical, "Abbruch"
Exit Function
End If
End If
Next
ANDERE_TABELLEN = True 'Erfolg vermerken.
End Function
Private Function TABELLE_AUF_NULL(strTabelle As String) As Boolean
' On Error GoTo Ende 'Fehlerbehandlung übernehmen.
With ThisWorkbook.Sheets(strTabelle) 'Alles auf dieses Tabellenblatt beziehen:
.Unprotect
.Range("E9:H39").ClearContents
.Range("F43").Value = "0"
.Protect
Application.Goto .Range("E9")
ActiveWindow.ScrollRow = 9
ThisWorkbook.Sheets("Jan").Range("I41").Value = "0"
ThisWorkbook.Sheets("Jan").Activate
End With
TABELLE_AUF_NULL = True 'Erfolg vermerken.
Ende:
' On Error GoTo 0 'Fehlerbehandlung zurückgeben.
End Function
Gruß
mike49