Den halben Monat berücksichtigen

[josef24]

Hallo und guten Abend. Ich möcht mittels VBA Code eine Datei befüllen, und dabei die möglichkeit haben die Monate bzw. wenn es 0,5 Monate wären dies als nachkommastellen ausgewiesen bekommen. Kann mir da jemand mit einer Berichtigung des Code behilflich sein? Gruß josef

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fehlerbehandlung

    Application.EnableEvents = False ' Deaktiviert Ereignisse während der Ausführung

    Dim C3 As Date, C4 As Date
    Dim Jahre As Double
    Dim Monate As Double
    Dim Tage As Double
    Dim Ergebnis As Double

    ' Werte aus den Zellen lesen
    C3 = Range("C3").Value
    C4 = Range("C4").Value

    ' Berechne BRTEILJAHRE (Bruchteile eines Jahres)
    Jahre = DateDiff("yyyy", C3, C4)
    Monate = DateDiff("m", C3, C4) Mod 12
    Tage = DateDiff("d", DateAdd("m", DateDiff("m", C3, C4), C3), C4)

    Dim BruchteilJahr As Double
    BruchteilJahr = Jahre + (Monate / 12) + (Tage / 365.25)

    ' Zusätzliche Logik für halbe Monate:
    Dim HalberMonatStart As Double
    Dim HalberMonatEnde As Double

    ' Prüfen, ob halber Monat am Startdatum gilt
    If Day(C3) < 16 Then
        HalberMonatStart = 0.5
    Else
        HalberMonatStart = 0
    End If

    ' Prüfen, ob halber Monat am Enddatum gilt
    If Day(C4) < 16 Then
        HalberMonatEnde = -0.5
    Else
        HalberMonatEnde = 0
    End If

    ' Gesamtergebnis berechnen
    Ergebnis = Application.WorksheetFunction.RoundUp(12 * BruchteilJahr, 0) + HalberMonatStart + HalberMonatEnde - 1

    ' Ohne Kommastellen, wenn DateDiff eine Bedingung erfüllt
    If DateDiff("d", C3, C4) < 365 Then
        Ergebnis = Application.WorksheetFunction.Round(Ergebnis, 0)
    End If

    ' Ergebnis in Zelle D4 schreiben
    Range("D4").Value = Ergebnis

Fehlerbehandlung:
    Application.EnableEvents = True ' Ereignisse wieder aktivieren
End Sub