Löschen Makro anpassen
03.09.2019 07:38:29
mike49
mein Löschen Makro funktioniert nicht richtig.
Ich habe in meinen Blättern Jan-Dez 2 leere Spalten gelöscht. Die Feiertage, auf die Bezug genommen wird stehen jetzt im Bereich Q9:R37, wobei in Spalte Q das Datum und in R der jeweilige Text des Feiertags stehen. Jetzt stimmt die Formel, die nach dem Löschen die Namen der Feiertage in den Bereich J5:J35 wieder eingetragen soll, nicht mehr! Wie müsste die Formel im Makro bei "FormulaLocal=" angepasst werden?
Option Explicit
Sub Löschen()
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("C5:H35").ClearContents
.Range("J5:J35").FormulaLocal = _
"=WENN(ISTNV(INDEX($S$9:$T$37;VERGLEICH($B5;$S$9:$S$37;0);2));"";INDEX($S$9:$T$37;VERGLEICH($B5;$S$9:$S$37;0);2))"
.Range("D37").Value = "0"
.Range("C5").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 = 3
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("C5:H35").ClearContents
.Range("J5:J35").FormulaLocal = _
"=WENN(ISTNV(INDEX($S$9:$R$37;VERGLEICH($B5;$S$9:$S$37;0);2));"""";INDEX($S$9:$T$37; _
VERGLEICH($B5;$S$9:$S$37;0);2))"
.Range("D37").Value = "0"
' .Protect
Application.GoTo .Range("C5")
ActiveWindow.ScrollRow = 3
ThisWorkbook.Sheets("Jan").Activate
End With
TABELLE_AUF_NULL = True 'Erfolg vermerken.
Ende:
' On Error GoTo 0 'Fehlerbehandlung zurückgeben.
End Function
Gruß
mike49