Löschen-Makro erweitern

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
UserForm MsgBox
Bild

Betrifft: Löschen-Makro erweitern
von: mike49
Geschrieben am: 15.06.2015 21:58:04

Hallo Leute,
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

Bild

Betrifft: AW: Löschen-Makro erweitern
von: UweD
Geschrieben am: 16.06.2015 09:05:35
Hallo
Mir ist zwar nicht klar, warum du das über Functions machst...
...aber so müsste es gehen. (ungetestet)

.Range("E9:H39").SpecialCells(xlCellTypeConstants, 23).ClearContents
Es werden nur die Zellen des Bereichs mit Konstanten (also ohne Formeln) genommen.
Du solltest noch eine Fehlerabfrage einbauen, falls keine Daten gefunden werden.
Übrigens:
auf
.ScrollRow
.select
kann verzichtet werden...
Gruß UweD

Bild

Betrifft: AW:Löschen-Makro erweitern
von: mike49
Geschrieben am: 16.06.2015 09:46:47
Hallo UweD,
danke, dass du dich der Sache angenommen hast.
Vielleicht habe ich mich undeutlich ausgedrückt: Ich will erreichen, dass zusätzlich die Einträge im Bereich L9:L39 gelöscht werden. Die Formeln sollen stehen bleiben bzw. nach dem Löschen wieder eingetragen werden. Ich habe mal testweise deinen Vorschlag mit dem abgeänderten Bereich eingefügt. Leider werden auch die Formeln mitgelöscht. Gerade bemerke ich, dass durch das Überschreiben der vorhandenen Formel diese beim Löschen ja logischerweise nicht mehr hergestellt werden kann.
Es müsste irgendwie anders gelöst werden. Vielleicht könnte ich den Bereich mit den Formeln in den Bereich T9:T39 kopieren. Nach dem Löschen könnte dann der Inhalt dieses Bereichs (Formeln)wieder eingefügt werden. Wie müsste man das Makro abändern?
Gruß
mike49

Bild

Betrifft: AW: AW:Löschen-Makro erweitern
von: UweD
Geschrieben am: 16.06.2015 10:00:28
Lade doch mal eine Musterdatei hoch.

Bild

Betrifft: AW: AW:Löschen-Makro erweitern
von: mike49
Geschrieben am: 16.06.2015 10:24:37
Der Größe wegen nur die Monate Jan und Feb (restliche Monate habe ich gelöscht).
https://www.herber.de/bbs/user/98236.xls

Bild

Betrifft: AW: AW:Löschen-Makro erweitern
von: UweD
Geschrieben am: 16.06.2015 10:57:22
Hallo nochmal
du musst doch gar nichts ändern.
In L9:L39 bleiben die Formeln doch weiterhin drin stehen.
Dadurch, dass du das Blatt schützt, werden die Formeln nur unsichtbar.
Gruß UweD

Bild

Betrifft: AW: AW:Löschen-Makro erweitern
von: mike49
Geschrieben am: 16.06.2015 12:38:01
Hallo UweD,
irgendwie steh' ich gerade auf der Leitung.
Teste mal Folgendes:
Trage im Blatt "Feb" in L13 "Test" ein. Dadurch wird die Formel überschrieben. Starte das Löschen-Makro über den Button "Inhalte Löschen" und setze nur das Tabellenblatt zurück. Der Text "Test" bleibt genauso stehen. Ich will aber, dass das Wort "Text" bzw. alle weiteren Texte im Bereich L9:L39, die die Formel überschrieben haben, gelöscht werden und die entsprechenden Ausgangsformeln für die Feiertagseinträge nach dem Löschen wieder eingetragen werden.
Ich hoffe, dass ichs verständlich erklärt habe.
Gruß
mike49

Bild

Betrifft: AW: AW:Löschen-Makro erweitern
von: UweD
Geschrieben am: 16.06.2015 12:51:42
Ok.
Das war nicht so klar, dass du die Formeln durch Text überschreibst.
Dann mach es so. (Der Bereich wird komplett wieder mit den Formeln beschrieben.)

...
   With ActiveSheet
      .Unprotect
      .Range("E9:H39").ClearContents
      .Range("F43").Value = "0"
      .Range("L9:L39").FormulaR1C1 = _
        "=IF(ISNA(INDEX(R10C17:R38C18,MATCH(RC3,R10C17:R38C17,0),2)),"""",INDEX(R10C17:R38C18, _
MATCH(RC3,R10C17:R38C17,0),2))"
      .Protect
   End With
...
Gruß UweD

Bild

Betrifft: AW: AW:Löschen-Makro erweitern
von: mike49
Geschrieben am: 16.06.2015 14:36:17
Hallo UweD,
super! Genau wie ichs wollte. Danke vielmals.
Ich habe noch eine andere Mappe, die ähnlich aufgebaut ist.
Ich wollte hier das Löschen-Makro mit deiner Lösung ebenfalls erweitern. Klappt nicht. Meine VBA-Kenntnisse reichen hier nicht aus.
Könntest du bitte mal einen Blick drauf werfen?
Wenn ich durch Rechtsklick im Bereich C5:C35 "Urlaub" eintrage, wird zwar in I5:I35 richtig "1:58" eingetragen, beim Löschen bleibt der Wert aber stehen, der sollte im Prinzip aber wieder durch die Formel ersetzt werden. Habe im Muster das bestehende Löschen-Makro mal gelassen.
https://www.herber.de/bbs/user/98248.xls
Wäre schön, wenn du mir nochmals hierbei behilflich wärst.
Gruß
mike49

Bild

Betrifft: AW: AW:Löschen-Makro erweitern
von: UweD
Geschrieben am: 16.06.2015 15:55:47
Hallo nochmal
Da wäre so möglich.


      .Range("C5:F35").ClearContents
      .Range("D37").Value = "0"
      .Range("I5:I35").FormulaR1C1 = _
        "=IF(OR(RC[-6]=""krank"",RC[-6]=""Urlaub""),TIMEVALUE(""1:58""),IF(AND(RC[-6]<>"""",RC[- _
5]<>"""",RC[-5]>RC[-6]), RC[-5]-RC[-6])+IF(AND(RC[-4]<>"""",RC[-3]<>"""",RC[-3]>RC[-4]),RC[-3]-RC[-4])-RC[-2])"
      .Protect
Ist aber widersprüchlich.
- Wenn du per Handeingabe "Urlaub" einträgst, dann greift die Formel
- wenn du aber per Rechtsclick den Eintrag vornehmen lässt, überschreibst du die Formel mit dem Festwert.
...
Target.Offset(0, 6) = CDate("1:58")
...
Beide Zeilen ### könnten weg
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
      If Not Intersect(Target, Range("C5:C35")) Is Nothing Then
          Cancel = True
          If Target = "" Then
              Select Case Target.Column
                  Case 3
                      Target = "Urlaub"
                      Target.Font.Color = -16776961
                      '###Target.Offset(0, 6) = CDate("1:58")
              End Select
          Else
              Target = ""
              '###Target.Offset(0, 6).ClearContents
              Target.Font.ColorIndex = xlAutomatic
          End If
      End If
  End Sub

Dann brauchst du den Formelbereich gar nicht zu Ändern/Rücksetzen.
Gruß UweD

Bild

Betrifft: Hat sich überschnitten . . .
von: mike49
Geschrieben am: 16.06.2015 16:01:54
. . . Danke nochmals.
Gruß
mike49

Bild

Betrifft: Habe den Fehler gefunden . . .
von: mike49
Geschrieben am: 16.06.2015 15:56:11
. . . In den Monatsblättern müssen beim "Rechtsklick-Makro" die 2 Zeilen mit "Target.Offset ..." heraus.
Dann klappts.
Danke nochmals UweD für deine Hilfe.
Gruß
mike49

Bild

Betrifft: Nochmals nachgefragt . . .
von: mike49
Geschrieben am: 16.06.2015 16:07:42
. . . gibt es eigentlich eine Möglichkeit beim Rechtsklick-Makro zu wählen, ob man "Urlaub" oder "Krank" (beides in roter Schrift)eintragen möchte, da bei beiden der Wert ja gleich ist?
Oder hättest du eine andere Variante?
Gruß
mike49

Bild

Betrifft: AW: Nochmals nachgefragt . . .
von: UweD
Geschrieben am: 16.06.2015 16:40:25
Du könnest eine Userform einblenden und dor z.B. 2 Buttons zeigen ...

Bild

Betrifft: AW: Nochmals nachgefragt . . .
von: mike49
Geschrieben am: 16.06.2015 18:23:40
O.K. Aber leider weiß ich nicht, wie man sowas macht.

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Löschen-Makro erweitern"