Kalenderwochen in Excel
09.04.2015 08:43:25
Patrick
ich versuche in Excel VBA mir die Kalenderwochen auszugeben.
Ich möchte hier, dass ich ein beliebiges Anfangsdatum und Enddatum eingegeben werden kann. VBA soll dann selbstständig die Richtige Kalenderwoche nach DI-Norm ausgeben, angefangen vom eingegebenen Datum bis entsprechend dem Enddatum.
Mein Problem dabei ist, dass das für genau ein Jahr kein Problem darstellt. Möchte ich jedoch mehrere Jahre betrachten schaffe ich es im Moment nur hochzuzählen, weiß aber nicht genau wie ich zwischen den einzelnen Jahren unterscheiden soll.
Beispielsweise von heute (09.04.2015) bis sagen 15.07.2017: Da sollte Excel dann KW15 bis KW53 ausgeben, danach sollte wieder KW1 bis KW52 ausgegeben werden und zum Schluss nach KW1 bis KW28 ausgeben.
Mir ist dabei wichtig, dass VBA vor allem automatisch erkennen kann dass es sich um ein Jahr mir 53 oder 52 Wochen handelt und entsprechend dies berücksichtig.
Bisher hab ich nur einen "relativ wirren" Code geschrieben, der etwas verschachtelt ist und ich mich irgendwie im Kreis drehe...
Option Explicit
Private DieWochen As Integer, i As Integer, DieWochen2 As Long
Sub Test_AnzWo()
Dim Anfang As Date
Dim Ende As Date
Dim Kw_Anfang As String
Dim Kw_Ende As String
Anfang = InputBox("Geben Sie bitte das Anfangsdatum ein:", "Anfangsdatum", Date)
Ende = InputBox("Geben Sie bitte das Enddatum ein:", "Enddatum", DateAdd("yyyy", 1, Anfang)) _
_
If Year(Anfang) = Year(Ende) Then
AnzWo Year(Anfang)
Kw_Anfang = "KW " & DINKw(Anfang)
Kw_Ende = "KW " & DINKw(Ende)
MsgBox ("Anfang: " & Kw_Anfang & " Ende: " & Kw_Ende)
ElseIf Year(Anfang) + 1 = Year(Ende) Then
AnzWo Year(Anfang)
For i = 1 To DieWochen
ActiveWorkbook.Worksheets("Tabelle1").Cells(4 + i, 2) = "KW" & i
Next
Else
AnzWo Year(Anfang)
If DieWochen2 > DieWochen Then
DieWochen2 = DateDiff("ww", Anfang, Ende, vbMonday, vbFirstFourDays)
For i = DatePart("ww", Anfang) To DieWochen
ActiveWorkbook.Worksheets("Tabelle1").Cells(4 + i, 2) = "KW" & i
Next
End If
End If
End Sub
Function AnzWo(XJahr As Integer)
For i = 31 To 28 Step -1
DieWochen = DIN_KW(DateSerial(XJahr, 12, i))
If DieWochen > 1 Then Exit For
Next
End Function
Function DIN_KW(DasDatum As Date) As Byte
Dim KW As Date
KW = 4 + DasDatum - Weekday(DasDatum, 2)
DIN_KW = (KW - DateSerial(Year(KW), 1, -6)) \ 7
End Function
Function DINKw(Datum As Date) As Integer
Dim IngT As Date
IngT = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
DINKw = (Datum - IngT - 3 + (Weekday(IngT) + 1) Mod 7) \ 7 + 1
End Function
Hab Ihr eine Lösung für mich, wie ich das geschickt hinbekommen?
Danke schon mal im Voraus!