AW: Montag für Kalenderwoche im nächsten Jahr
12.11.2007 22:20:00
Hajo_Zi
Hallo Otto,
es wäre wohl von Vorteil gewesen hättest Du die Datei sofort hochgeladen oder den Ursprung verlinkt. Ich hoffe mal ich habe es korrekt verstanden.
Function Montag_1(InKW As Date) As Date
' wird benöigt für TXT_Kw
' Montag ermitteln
' http://www.excelformeln.de/ _
formeln.html?welcher=186
' Ermittlung in Tabelle
' Sensationell verkürzt von Peter Dorigo:
' =DATUM(A2;1;7*A1-3-WOCHENTAG(DATUM(A2;;);3))
Montag_1 = DateSerial(Year(Date) + 1, 1, 7 * InKW - 3 - Weekday(DateSerial(Year(Date) + 1, _
0, 0), 3))
End Function
' Ereignis, welches bei Verlassen ausgelöst wird
'Private Sub TXT_Kw_AfterUpdate()
Private Sub TXT_Kw_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TXT_Kw = 0 Or TXT_Kw = "" Then
TXT_Kw = "" ' Textbox löschen falls Null eingegeben wurde
' Prüfen ob eingegebene Zahl größer als Kalenderwochen im aktuellen Jahr
Else
If KALENDERWOCHE_DIN(Date) > CInt(TXT_Kw) Then
If KALENDERWOCHE_DIN("31.12." & Year(Date)) = 1 Then
If CInt(TXT_Kw) > 52 Then
TXT_Kw = "" ' Eingabe Kalenderwoche löschen
LBL_Montag.Caption = "" ' Anzeige Montag löschen
Else
' ermitteln des Montags der Kalenderwoche und Anzeige in LBL_Montag
LBL_Montag.Caption = "Montag, den " & Format(Montag_1(TXT_Kw), "dd.mm.yy")
End If
Else
If CInt(TXT_Kw) > KALENDERWOCHE_DIN("31.12." & Year(Date)) Then
TXT_Kw = "" ' Eingabe Kalenderwoche löschen
LBL_Montag.Caption = "" ' Anzeige Montag löschen
Else
' ermitteln des Montags der Kalenderwoche und Anzeige in LBL_Montag
LBL_Montag.Caption = "Montag, den " & Format(Montag_1(TXT_Kw), "dd.mm.yy")
End If
End If
Else
If KALENDERWOCHE_DIN("31.12." & Year(Date)) = 1 Then
If CInt(TXT_Kw) > 52 Then
TXT_Kw = "" ' Eingabe Kalenderwoche löschen
LBL_Montag.Caption = "" ' Anzeige Montag löschen
Else
' ermitteln des Montags der Kalenderwoche und Anzeige in LBL_Montag
LBL_Montag.Caption = "Montag, den " & Format(Montag(TXT_Kw), "dd.mm.yy")
End If
Else
If CInt(TXT_Kw) > KALENDERWOCHE_DIN("31.12." & Year(Date)) Then
TXT_Kw = "" ' Eingabe Kalenderwoche löschen
LBL_Montag.Caption = "" ' Anzeige Montag löschen
Else
' ermitteln des Montags der Kalenderwoche und Anzeige in LBL_Montag
LBL_Montag.Caption = "Montag, den " & Format(Montag(TXT_Kw), "dd.mm.yy")
End If
End If
End If
End If
End Sub
Ich habe jetzt keine Optimierungen durchgeführt.