VBA-Code mit sporadischen Fehler
27.10.2023 13:51:14
Bernd Fuchs
ich habe hier einen sporadischen Fehler, für den ich keine Ursache bzw. Abstellmaßnahme finden kann.
Für die gelegentliche Umrechnung von Datum in Wochen und Zeitpunkte in der Zukunft habe ich mir den Code zusammengebastelt.
Jetzt habe ich das Problem, dass ohne erkennbaren Grund "Fehler beim Kompileren: Projekt oder..." erscheint, sobald ich in einer völlig anderen Zelle irgendwo auf dem Blatt etwas ändere. Es funktioniert manchmal tagelang ohne Probleme und dann auf einmal ist der Fehler da.
Es wird mir dabei immer die Zeile "datHeute = Date" markiert.
Mache ich die Excel neu auf, funktioniert alles wie es soll.
Hat jemand eine Idee?
'Automatisch Datum eintragen
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim intTag As Integer
Dim intWoche As Integer
Dim datDatum As Date
Dim datHeute As Date
intTag = ActiveSheet.Range("E3").Value
intWoche = ActiveSheet.Range("E4").Value
datDatum = ActiveSheet.Range("E2").Value
datHeute = Date
'Tage in Wochen
Dim C As Range
If Not Intersect(Target, Range("E3")) Is Nothing Then
For Each C In Intersect(Target, Range("E3"))
Application.EnableEvents = False
If IsNumeric(C.Text) Then
C.Offset(1, 0) = WorksheetFunction.RoundUp((intTag / 7), 0)
C.Offset(-1, 0) = datHeute + intTag
Else
C.Offset(1, 0).ClearContents
C.Offset(-1, 0).ClearContents
End If
Application.EnableEvents = True
Next
End If
'Wochen in Tage
Dim D As Range
If Not Intersect(Target, Range("E4")) Is Nothing Then
For Each D In Intersect(Target, Range("E4"))
Application.EnableEvents = False
If IsNumeric(D.Text) Then
D.Offset(-1, 0) = intWoche * 7
D.Offset(-2, 0) = intWoche * 7 + Date
Else
D.Offset(-1, 0).ClearContents
D.Offset(-2, 0).ClearContents
End If
Application.EnableEvents = True
Next
End If
'Datum
Dim E As Range
If Not Intersect(Target, Range("E2")) Is Nothing Then
For Each E In Intersect(Target, Range("E2"))
Application.EnableEvents = False
If IsNumeric(E.Text) Then
E.Offset(1, 0) = datDatum - datHeute
E.Offset(2, 0) = WorksheetFunction.RoundUp(((datDatum - datHeute) / 7), 0)
Else
E.Offset(1, 0).ClearContents
E.Offset(2, 0).ClearContents
End If
Application.EnableEvents = True
Next
End If
On Error GoTo 0
End Sub