Ein Hallo
so jetzt haben wir zu zweit daran gesessen und sind schon weiter gekommen.
jetzt will er aber irgendwie nicht durchzählen.
vieleicht habt Ihr ja eine Idee wo der Fehler sitzt??
Sub wrapper_make_time()
Call make_time(Sheets("Start").Range("G4").Text)
End Sub
Sub make_time(year As String)
Dim month, bebefore, before, curr_date, week_day As String
Dim curr As Range
month = ActiveSheet.Range("I8").Text
curr_date = Format("01." & month & "." & year, "dd.mm.yyyy")
For i = 18 To 59
bebefore = ActiveSheet.Cells(i - 2, 2).Text
before = ActiveSheet.Cells(i - 1, 2).Text
Set curr = ActiveSheet.Cells(i, 2)
week_day = ActiveSheet.Cells(i, 3).Text
If before = "" Or before = "1" Then
If Len(before) = 2 And Len(week_day) > 1 Then
curr_date = Int(before) + 1 & Right(curr_date, 8)
If test_end_date(curr_date) Then
Exit Sub
End If
curr = Format(curr_date, "dd")
ElseIf Len(bebefore) = 2 And Len(week_day) > 1 Then
curr_date = Int(bebefore) + 1 & Right(curr_date, 8)
If test_end_date(curr_date) Then
Exit Sub
End If
curr = Format(curr_date, "dd")
ElseIf week_day = Format(curr_date, "ddd") Then
curr = Format(curr_date, "dd")
End If
End If
Next i
End Sub
Function test_end_date(ByVal curr_date As String) As Integer
Dim my_test As Date
Dim Res As Integer
Res = 0
On Error GoTo err_month:
my_test = Format(curr_date, "dd.mm.yyyy")
If Day(my - test) > Day(Application.WorksheetFunction.EoMonth(my_test, 0)) Then
Res = 1
End If
test_end_date = Res
Exit Function
err_month:
test_end_date = 1
End Function
Im Anhang wieder meine Test datei zum Probieren.