08-01-2023, 11:15
Code:
Sub datum_erkennen_1()
'
Dim LstrDate As String
Dim LDate As Date
'
'LstrDate = "12.08.2019"
'
LstrDate = Range("C6").Value
LDate = CDate(LstrDate)
'
'MsgBox LDate
Debug.Print LDate
'
End Sub
Code:
Sub datum_erkennen_2()
'
Dim tag As Date
'
tag = CDate(Range("C6").Value)
'
'MsgBox tag
Debug.Print tag
'
End Sub
Code:
Sub datum_erkennen_3()
'
Dim tag1 As String
Dim tag2 As String
Dim tag3 As String
'
tag1 = Year(CDate(Range("C6").Value))
tag2 = Month(CDate(Range("C6").Value))
tag3 = Day(CDate(Range("C6").Value))
'
Debug.Print tag1
Debug.Print tag2
Debug.Print tag3
'
End Sub
Code:
Sub tagesdatum()
'
Debug.Print Date
Debug.Print Time
Debug.Print WeekdayName(Weekday("14.08.2019"), False, vbSunday)
Debug.Print Format("14.08.2019", "DDDD")
Debug.Print Choose(Weekday("14.08.2019"), "Sonntag", "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag")
'
End Sub
Code:
Sub kw_ermitteln()
'
Dim kw As Integer
'
'Aufruf der Funktion (siehe unten) mit Parameter
kw = DINKw("14.08.2019")
'
'kw = DINKw(Range("A1").value)
'
'MsgBox kw
'
Debug.Print "Kalenderwoche: " & kw
'
End Sub
Code:
Function DINKw(dat As Date) As Integer
'
Dim kw As Integer
'
kw = Int((dat - DateSerial(Year(dat), 1, 1) + ((Weekday(DateSerial(Year(dat), 1, 1)) + 1) Mod 7) - 3) / 7) + 1
'
If kw = 0 Then
'
kw = DINKw(DateSerial(Year(dat) - 1, 12, 31))
'
ElseIf kw = 53 And (Weekday(DateSerial(Year(dat), 12, 31)) - 1) Mod 7 <= 3 Then
'
kw = 1
'
End If
'
DINKw = kw
'
End Function