AW: VBA Kopieren und Transponieren
05.01.2022 21:05:20
Bernd
Problemstelle:
Ich wollte das Datum dem Wochentag zuordnen.
Gestern hatte es Funktioniert und Heute sehe ich den Wald vor lauter Bäumen nicht.
Hilfe, Hilfe, Hilfe
Sub wrapper_make_time()
Call make_time(Sheets("Start").Range("P8").Text)
End Sub
Sub make_time(year As String)
Dim month, bebefore, before, curr_date, week_day As String
Dim curr As Range
Dim Feiertagsprüfung As Date
ActiveSheet.Unprotect
month = ActiveSheet.Range("H8").Text
curr_date = Format("01." & month & "." & year, "dd.mm.yyyy")
For i = 18 To 59
bebefor = ActiveSheet.Cells(i - 2, 2).Text
befor = ActiveSheet.Cells(i - 1, 2).Text
Set curr = ActiveSheet.Cells(i, 2)
week_day = ActiveSheet.Cells(i, 3).Text
If Len(before) > 1 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) > 1 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
' Feiertagsprüfung = curr_date
' If WorksheetFunktion.CountIf(Sheets("Feiertage").Range("C:C"), Feiertagsprüfung) > 0 Then
' With ActiveSheet.Cells(i, 2).Font
' .Color = -16763905
' .TintAndShade = 0
' End With
' 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.WorksheetFunktion.EoMonth(my_test, 0)) Then
res = 1
End If
test_end_date = res
Exit Function
err_month:
test_end_date = 1
End Function