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, 23:18 (Dieser Beitrag wurde zuletzt bearbeitet: 07.10.2019, 23: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.
08.10.2019, 04:23 (Dieser Beitrag wurde zuletzt bearbeitet: 08.10.2019, 04: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.
