Kalenderwoche VBA

Frank · 2020-07-14T17:40:57+00:00

Hallo an alle, ich habe ein Problem mit dem Ausrechnen bzw. Anzeigen der Kalenderwoche. mit dieser Zeile füge ich die Kalenderwochen ein • Cells(2, Spalte).Value = Format(dDatum, "DDDD", vbMonday) & " - " & Format(dDatum, "ww", vbMonday) so sieht es dann aus "Freitag - 1" das funktionier für das Jahr 2020 ohne Probleme, aber für 2021 geht das nicht, da der 01.01.2021 als Kalenderwoche 1 erkannt wird, aber dies müsste noch Kalenderwoche 53 sein. kann mir jemand dabei helfen was ich anders machen sollte, oder geht das nicht ? danke für eure Hilfe Frank

Hallo,
danke für die Antwort.
Leider funktioniert die auch nicht bei 2021
hier ist mal der Original Code (muss Tabellenblatt 1-12 vorhanden sein - für alle Monate)
Option Explicit

Sub Kalender_Farben_Datum_2()
Dim Monat, Tag As Long
Dim dDatum As Date
Dim Spalte As Long
Dim Jahr, Farbe, Schicht, f As String
Dim wks As Long
Application.ScreenUpdating = False
Jahr = InputBox("Bitte Jahr eingeben", "Jahr", Year(Now) + 1)
Schicht = InputBox("Welche Schicht wird gestartet?", "Farbe", "1, 2 oder 3")
If Not IsNumeric(Schicht) Or Not IsNumeric(Jahr) Or Len(Jahr)  4 Or Len(Schicht)  1  _
Then
MsgBox "Falsche Eingabe. Bitte erneut versuchen.", vbOKOnly, "Falsche Eingabe"""
Exit Sub
End If
Monat = 1
Select Case Schicht
Case 1: Farbe = 65535
Case 2: Farbe = 49407
Case 3: Farbe = 5296274
End Select
For wks = 1 To 12
Sheets(wks).Activate
'Datum
With Range("H2:AL3")
.Interior.Pattern = xlNone
.ClearContents
End With
dDatum = DateSerial(Jahr, Monat, 1)
Spalte = 8
With ActiveSheet
.Range("C2").Value = Jahr
Do
For Tag = 1 To 31
With .Cells(2, Spalte)
'### Färben ###
If Weekday(dDatum) = 1 Or Weekday(dDatum) = 7 Then
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 90
.Font.Size = 11
With .Interior
.Pattern = xlGray50
.PatternColorIndex = 2
.Color = 255
End With
'Wochenende mit einfärben -
'Zeile anpassen
With Range(Cells(4, Spalte), Cells(48, Spalte)).Interior
.Pattern = xlGray50
.PatternColorIndex = 2
.Color = 255
End With
Else
'wenn nicht Wochenende, dann weiß
With Range(Cells(4, Spalte), Cells(48, Spalte)).Interior
.Pattern = xlAutomatic
.PatternColorIndex = 2
.Color = 16777215    'weiß
End With
f = Format(dDatum, "w", vbMonday)
With .Interior
.Color = Farbe
.Pattern = xlAutomatic
End With
If f = 5 Then
If Farbe = 65535 Then
Farbe = 5296274    'Nachtschicht
ElseIf Farbe = 5296274 Then
Farbe = 49407    'Spätschicht
ElseIf Farbe = 49407 Then
Farbe = 65535    'Frühschicht
End If
f = 0
End If
.Font.Bold = False
End If
'### Datum eintragen ###
If Weekday(dDatum) = 2 Or Day(dDatum) = 1 Then 'wenn Montag
Cells(2, Spalte).NumberFormat = "General"
Cells(2, Spalte).Value = Format(dDatum, "DDDD", vbMonday) & " -  _
" & Format(dDatum, "ww", vbMonday)
Else
.NumberFormat = "dddd"
.Value = dDatum
End If
With Cells(3, Spalte)
.NumberFormat = "d."
.Value = dDatum
End With
End With
dDatum = dDatum + 1
Spalte = Spalte + 1
If Month(dDatum)  Monat Then Exit For
Next Tag
Loop While Month(dDatum) = Monat
Range("A1").Select
Monat = Monat + 1
End With
Next wks
Sheets(1).Activate
Application.ScreenUpdating = True
End Sub

ich bin für alle Änderungen und Verbesserungen offen
danke
Frank

Forumthread: Kalenderwoche VBA

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial

VBA zur Ermittlung der Kalenderwoche in Excel

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)