Automatische Berechnung VBA

[chillern1]

Hallo Leute,

ich habe eine Excel Liste mit einigen VBA codes, welche ich nicht selber geschrieben habe.
Nun ist mir leider ein Fehler in einem Code aufgefallen und ich weiß leider nicht wie ich diesen ausbügeln kann.
Das Prinzip ist Folgendes: Es werden Änderungen in den Reitern Project ABC und Project XYZ (es können noch mehr Reiter dazukommen) vorgenommen und diese sind dann im Reiter "Overview" zu sehen.
Einige VBA Codes berechnen automatisch Fälligkeitsdaten und/ oder die Duration/Dauer des Arbeitspaketes.
Es gibt dabei verschiedene Szenarien, welcher der folgende Code beschreibt:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With Target
    If .Parent.Name = "Overview" Or .Parent.Name = "Master Gantt" Then Exit Sub
    If .Count > 1 Or .Row < 9 Then Exit Sub
    If Not IsDate(Cells(.Row, 9)) Then Exit Sub
'--------------------------------------
'TARGET = START DATE
    If .Column = 9 Then
'SCENARIO 1- START DATE ENTERED/CHANGED
        Scenario2 Target
        Scenario3 Target
        Scenario4 Target
        Scenario5 Target
    End If
'--------------------------------------
'TARGET = DURATION
    If .Column = 10 Then
'--------------------------------------
'SCENARIO 2- START - DURATION - NO RESCHEDULE DATE
        Scenario2 Target
'--------------------------------------
'SCENARIO 3- START - DURATION - RESCHEDULE DATE PRESENT
        Scenario3 Target
    End If
'--------------------------------------
'TARGET = DUE DATE
    If .Column = 11 Then
'--------------------------------------
'SCENARIO 4- START - DUE - NO RESCHEDULE DATE
        Scenario4 Target
'--------------------------------------
'SCENARIO 5- START - DUE - RESCHEDULE DATE PRESENT
        Scenario5 Target
    End If
'--------------------------------------
'TARGET = RESCHEDULE DATE
    If .Column = 12 Then
'--------------------------------------
'SCENARIO 6- START - RESCHEDULE DATE
        Scenario5 Target
    End If
End With
End Sub

Public Sub Scenario2(ByVal rng As Range)
'--------------------------------------
'SCENARIO 2- START - DURATION - NO RESCHEDULE DATE
    With rng
        If Not IsEmpty(Cells(.Row, 10)) And IsNumeric(Cells(.Row, 10)) And IsEmpty(Cells(.Row, 12)) Then
            With WorksheetFunction
                Application.EnableEvents = False
                    Cells(rng.Row, 11) = .WorkDay(Cells(rng.Row, 9), Cells(rng.Row, 10), Range("T10:T15"))
                Application.EnableEvents = True
            End With
        End If
    End With
    Set rng = Nothing
End Sub
Public Sub Scenario3(ByVal rng As Range)
'--------------------------------------
'SCENARIO 3- START - DURATION - RESCHEDULE DATE PRESENT
    With rng
        If Not IsEmpty(Cells(.Row, 10)) And IsNumeric(Cells(.Row, 10)) And IsDate(Cells(.Row, 12)) Then
            With WorksheetFunction
                Application.EnableEvents = False
                    Cells(rng.Row, 12) = .WorkDay(Cells(rng.Row, 9), Cells(rng.Row, 10), Range("T10:T15"))
                Application.EnableEvents = True
            End With
        End If
    End With
    Set rng = Nothing
End Sub
Public Sub Scenario4(ByVal rng As Range)
'--------------------------------------
'SCENARIO 4- START - DUE - NO RESCHEDULE DATE
    With rng
        If IsDate(Cells(.Row, 11)) And IsEmpty(Cells(.Row, 12)) Then
            Application.EnableEvents = False
                With WorksheetFunction
                    Cells(rng.Row, 10) = .NetworkDays(Cells(rng.Row, 9), Cells(rng.Row, 11), Range("T10:T15"))
                End With
            Application.EnableEvents = True
        End If
    End With
    Set rng = Nothing
End Sub
Public Sub Scenario5(ByVal rng As Range)
'--------------------------------------
'SCENARIO 5- START - DUE - RESCHEDULE DATE PRESENT
    With rng
        If IsDate(Cells(.Row, 12)) Then
            Application.EnableEvents = False
                With WorksheetFunction
                    Cells(rng.Row, 10) = .NetworkDays(Cells(rng.Row, 9), Cells(rng.Row, 12), Range("T10:T15"))
                End With
            Application.EnableEvents = True
        End If
    End With
    Set rng = Nothing
End Sub

Und dabei geht es um das zweite Szenario (Duration/Dauer bekannt und Start datum wird eingetragen). Und zwar wird dabei als erstes die Dauer eingetragen, irgendwann dann das Start Datum und dann automatisch das Estimated Due Date berechnet. Funktioniert im Wesentlichen auch ganz gut. Nur leider ist es so, dass es nur richtig funktioniert, wenn das Start Datum in der Vergangenheit liegt. Trage ich ein Start Datum später oder gleich heute ein, so wird automatisch zu der Duration ein Tag hinzuaddiert, was natürlich nicht sein darf.

Kann mir bitte jemand helfen diesen Fehler zu beheben?

Danke im voraus :)

[Kuwer]

Hallo,

Public Sub Scenario2(ByVal rng As Range)

'--------------------------------------

'SCENARIO 2- START - DURATION - NO RESCHEDULE DATE

   With rng

     If .Value < Date Then

       If Not IsEmpty(Cells(.Row, 10)) And IsNumeric(Cells(.Row, 10)) And IsEmpty(Cells(.Row, 12)) Then

           With WorksheetFunction

               Application.EnableEvents = False

                   Cells(rng.Row, 11) = .WorkDay(Cells(rng.Row, 9), Cells(rng.Row, 10), Range("T10:T15"))

               Application.EnableEvents = True

           End With

       End If

     End If

   End With

   Set rng = Nothing

End Sub

Gruß Uwe

[snb]

z.B.

 

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If InStr("OverviewMaster Gantt", Sh.Name) Then Exit Sub
  If Target.Count > 1 Or Not IsDate(sh.Cells(Target.Row, 9)) Then Exit Sub
  
  Select Case Target.Column
  Case 9
    Scenario2 Target
    Scenario3 Target
    Scenario4 Target
    Scenario5 Target
  Case 10
    Scenario2 Target
    Scenario3 Target
  Case 11
    Scenario4 Target
    Scenario5 Target
  Case 12
    Scenario5 Target
  End Select
End Sub

[chillern1]

@snb: Vielen Dank. Als ich versucht habe deinen Code einzufuegen, habe ich leider einen Fehler erhalten (s. Anhang). Woran koennte das liegen? Ich habe es einfach unter den alten Code eingefuegt.

[chillern1]

Hallo Uwe,

ich habe den Code gemäß deiner Änderung angepasst. Jetzt springt zwar die Duration nicht mehr um eins hoch, das ist gut und richtig, jedoch wird nun auch nicht mehr das Estimated due date berechnet, wenn das Startdatum >= Heute ist. Gibt es eine Moeglichkeit den Code so zu aendern, dass wenn egal welches Start Datum das Estimated Due Date berechnet wird?

Danke im voraus.

[Kuwer]

... habe ich leider einen Fehler erhalten (s. Anhang). Woran koennte das liegen? Ich habe es einfach unter den alten Code eingefuegt.

genau das ist der Fehler, weil Ereignismakros einmalig pro Datei sind. Also ersetze es.

Gruß Uwe

[chillern1]

Hallo,

also ich habe es nun ersetzt und leider ist der Fehler damit nicht behoben. Es wird immer noch ein Tag dazuaddiert zu der Duration, wenn ich das Startdatum eintrage.
Es hat sich somit nichts geaendert. Noch mehr Ideen? Wie gesagt, das Makro funktioniert, aber die Ausfuehrung ist nicht korrekt.

Danke im voraus.