Sub Datum()
Dim ws As Worksheet
Dim letzte As Long
Set ws = Worksheets("Datum")
letzte = ws.Cells(Rows.Count, 1).End(xlUp).Row
If ws.Cells(letzte, 1).Value = Date Then
MsgBox "Makro wurde heute schon ausgeführt!"
Else
ws.Cells(letzte + 1, 1) = Date
Call continue 'DeinMakro muss ersetzt werden durch den Namen deines Makros
End If
End Sub
Wenn ich es so einfüge und ausführe, kommt diese Fehlermeldung: Fehler beim Kompilieren: If Block ohne End If
Das glaube ich gerne, denn in deinem Makro "continue" fehlt ein End If vor End Sub.
Ich hab deinen Code mal etwas gekürzt. Select brauchst du zu 99,9 % nicht.
Code:
Range("A1").Select
Selection.ClearContents
ist das Gleiche wie
Range("A1").ClearContents
Code:
Sub continue()
CarryOn = MsgBox("Willst du diese Tabellen-Eingaben Resetten? Achtung! Alle Eingaben werden unwiderruflich gelöscht! ", vbYesNo, "ACHTUNG!!")
If CarryOn = vbYes Then
ActiveSheet.Unprotect
With Sheets("zusammenfassung")
.Range("J68") = Range("I68")
.Range("K66").ClearContents
End With
With Sheets("zusammenfassung").Range("J68")
.NumberFormat = "#,##0.00 $"
.Font.Bold = True
End With
With Sheets("Spatschicht")
.Range("J38:J47").ClearContents
.Range("H38:H41").ClearContents
.Range("J27:J32").ClearContents
.Range("H27:H32").ClearContents
.Range("J9:J23").ClearContents
.Range("H9:H20").ClearContents
.Range("H45:H47").ClearContents
End With
With Sheets("Frühschicht")
.Range("J9:J23").ClearContents
.Range("J27:J32").ClearContents
.Range("H27:H32").ClearContents
.Range("J38:J47").ClearContents
.Range("H38:H41").ClearContents
.Range("H45:H48").ClearContents
.Range("H9:H20").ClearContents
End With
Sheets("Frühschicht").Range("J7") = Sheets("Zusammenfassung").Range("J68")
ActiveSheet.Paste
ActiveSheet.Protect
End If
End Sub
07.10.2019, 22:18 (Dieser Beitrag wurde zuletzt bearbeitet: 07.10.2019, 22:22 von Käpt'n Blaubär.)
Hallo,
hättest Du halbwegs vernünftige Einrückungen benutzt, dann hättest Du
selbst entdecken können, wo das End If fehlt.
Zitat:Option Explicit
Sub continue()
CarryOn = MsgBox("Willst du diese Tabellen-Eingaben Resetten? Achtung! Alle Eingaben werden unwiderruflich gelöscht! ", vbYesNo, "ACHTUNG!!") If CarryOn = vbYes Then
ActiveSheet.Unprotect
. . .
ActiveSheet.Paste
Range("K13").Select
ActiveSheet.Protect End If
End Sub
Im übrigen: hast Du Deinen Code schon mal durchlaufen lassen und Dich über die Laufzeit und
den ständig flackernden Bildschirm geärgert? Das liegt an Deinen Unmengen an Select.
Bei jedem SELECT und bei jedem ACTIVATE zwingst Du Dein Programm zu einem Neudurchlauf.
Das kannst Du ganz eindrucksvoll erleben, wenn Du den Code im Einzelschrittmodus durchlaufen
läßt. Paß aber auf, daß Dir dabei nicht schwindelig wird Aus diesem Grunde wird Dir jeder Helfer raten, schmeiße die SELECTs und die AKTIVATEs raus. In den allermeisten Fällen sind sie überflüssig und stören den Programmablauf.
________________________________________________________________________
wer aufgibt, ohne es versucht zu haben, gibt einfach nur auf!
08.10.2019, 03:23 (Dieser Beitrag wurde zuletzt bearbeitet: 08.10.2019, 03:28 von hddiesel.)
Hallo Beltason,
Code:
Option Explicit
Sub continue()
Dim wsP As Worksheet
Dim letzte As Long
letzte = Worksheets("Datum").Cells(Rows.Count, "A").End(xlUp).Row
Select Case MsgBox("Willst du diese Tabellen-Eingaben < Resetten >?" _
& vbLf & vbLf & vbTab & "<<<<< ACHTUNG! >>>>>" _
& vbLf & vbLf & vbLf & "Alle Eingaben werden unwiderruflich gelöscht!", vbYesNo, "<<<<<<<<<<< ACHTUNG! >>>>>>>>>>>")
Case vbYes
With Sheets("zusammenfassung")
.Range("I68").Copy Destination:=.Range("J68")
.Range("K66").ClearContents
End With
With Sheets("zusammenfassung").Range("J68")
.NumberFormat = "#,##0.00 $"
.Font.Bold = True
End With
With Sheets("Spatschicht")
.Range("J38:J47,H38:H41,J27:J32,H27:H32,J9:J23,H9:H20,H45:H47").ClearContents
End With
With Sheets("Frühschicht")
.Range("J9:J23,J27:J32,H27:H32,J38:J47,H38:H41,H45:H48,H9:H20").ClearContents
Sheets("Zusammenfassung").Range("J68").Copy Destination:=.Range("J7")
End With
Case vbNo
Worksheets("Datum").Cells(letzte, "A").ClearContents
Case Else
Worksheets("Datum").Cells(letzte, "A").ClearContents
End Select
For Each wsP In ActiveWorkbook.Worksheets
With wsP
.Protect DrawingObjects:=False, AllowFormattingCells:=False, Contents:=True, Scenarios:=True, _
AllowSorting:=True, AllowInsertingHyperlinks:=True, AllowFiltering:=True
End With
Next
End Sub
Sub Datum()
Dim ws As Worksheet
Dim wsP As Worksheet
Dim letzte As Long
Set ws = Worksheets("Datum")
letzte = ws.Cells(Rows.Count, "A").End(xlUp).Row
If ws.Cells(letzte, "A").Value = Date Then
MsgBox "Makro wurde heute schon ausgeführt!"
Else
For Each wsP In ActiveWorkbook.Worksheets
With wsP
.Unprotect
End With
Next
ws.Cells(letzte + 1, "A") = Date
Call continue
ich habe deinen Code ins Modul 131 eingefügt. Leider kommt eine Debug Fehler Meldung. Ich schäme mich langsam, das Ich DAU euch so lange aufhalte.
Ich habe jetzt einfach mal die komplette Tabelle hochgeladen. (Ungern eigendlich)
Vieleicht schaust du mal darüber.
ich hänge dir die Datei einmal an,
Setze im Makro Reset_continue einen Haltepunkt und prüfe das Makro continue, ob die Zellen richtig angegeben sind.
Welche Zellen geleert werden und welche Werte in eine Zelle übernommen werden.
Schau dir auch einmal die geänderten Summenformeln, in Zusammenfassen an.
