|
An dieser Stelle wollen wir uns einmal das Thema der Kalenderwoche in Excel VBA vornehmen. Das kommt daher, dass im Forum eine, für mich, recht interessante Frage zu stande gekommen ist. Gegeben war der folgende Tabellenausschnitt: | | D | E | F | G | | 3 | 01.01.2010 | 02.01.2010 | 03.01.2010 | 04.01.2010 | | 4 | Fr | Sa | So | Mo | | 5 | 53 | | | 1 |
In Zeile 3 stehen alle Tage eines Monats. Zeile 5 soll die Kalenderwochen des Monats wieder geben. Zusätzlich muss gesagt sein, dass für jeden Monat ein Tabellenblatt, wie dieses, existiert und das die Kalenderwoche nur am Ersten des Monats oder Montags angezeigt werden soll. Wie kann man hier vorgehen? Wie löst man das Problem der Berechnung der Kalenderwoche? Eine normale Funktion für die Kalenderwoche, welche in einem Modul eingefügt werden muß, schaut so aus:
Option Explicit
Public Function KW(d As Date) As Byte
Dim t As Double
t = DateSerial(Year(d + (8 - Weekday(d)) Mod 7 - 3), 1, 1)
KW = (d - t - 3 + (Weekday(t) + 1) Mod 7) \ 7 + 1
End Function
Mit diesem Beispiel habt ihr euch eine eigene "Formel" für die Kalenderwoche erstellt. Man ruft die Funktion auf, in dem ihr in die Zellen =KW(Zelle) schreibt. Hier folgt, zur besseren Verständnis, der Tabellenausschnitt mit den eingetragenen Funktionsaufrufen: | | D | E | F | G | | 3 | 01.01.2010 | 02.01.2010 | 03.01.2010 | 04.01.2010 | | 4 | Fr | Sa | So | Mo | | 5 | 53 | 53 | 53 | 1 |
| Formeln der Tabelle | | Zelle | Formel | | D5 | =kw(D3) | | E5 | =kw(E3) | | F5 | =kw(F3) | | G5 | =kw(G3) |
|
OK, aber hier wird ja für jeden Tag die Kalenderwoche eingetragen. Wir müssen am Code noch etwas tun. Es kam der folgende Vorschlag:
Option Explicit
Sub Kalenderwoche()
Dim KW As Integer
Dim kw2 As Integer
Dim Datum As Date
Dim loletzte As Long
Dim i As Integer
Dim Monat As Integer
For Monat = 1 To 12
Datum = Sheets(Monat).Cells(3, 4).Value
KW = ((4 + Datum - Weekday(Datum, 2)) - DateSerial(Year(4 + Datum - Weekday(Datum, 2)), 1, -6)) \ 7
Sheets(Monat).Cells(5, 4) = KW
If Monat = 1 Then
If KW > 1 Then KW = 0
kw2 = KW + 1
End If
loletzte = Sheets(Monat).Cells(3, Columns.Count).End(xlToLeft).Column
Sheets(Monat).Range(Sheets(Monat).Cells(5, 5), Sheets(Monat).Cells(5, loletzte)).ClearContents
If Monat <> 1 Then
Sheets(Monat).Cells(5, 4) = KW
kw2 = KW + 1
End If
For i = 5 To loletzte
If Weekday(Sheets(Monat).Cells(3, i)) = vbMonday Then
Sheets(Monat).Cells(5, i) = kw2
kw2 = kw2 + 1
End If
Next
Next
End Sub
Bei diesem Makro handelt es sich nicht mehr um eine Funktion, sondern um eine Prozedur, sprich ein Makro, welches mit einem Schalter ausgeführt werden kann. Der Code war zufriedenstellend. Was macht der Code? Die Kalenderwoche wird im Code nur für den 1.1. eines Jahres berechnet und an eine Variable weiter gegeben. Diese wird bei jedem Treffer um 1 erhöht, sprich man trägt jeden Montag die Kalenderwoche in Zeile 5 ein und rechnet wieder eine Kalenderwoche drauf. Von mir überarbeitet sieht der Code noch etwas anders aus. Man konnte diesen noch fast um die Hälfte einkürzen (Das passierte aber erst ganz zum Schluß):
Option Explicit
Sub Kalenderwoche()
Dim KW As Byte
Dim Datum As Date
Dim loletzte As Long
Dim i As Byte
Dim Monat As Byte
For Monat = 1 To 12
loletzte = Sheets(Monat).Cells(3, Columns.Count).End(xlToLeft).Column
Sheets(Monat).Range(Sheets(Monat).Cells(5, 4), Sheets(Monat).Cells(5, loletzte)).ClearContents
For i = 4 To loletzte
Datum = Sheets(Monat).Cells(3, i).Value
If Day(Datum) = 1 Or Weekday(Sheets(Monat).Cells(3, i)) = vbMonday Then
KW = ((4 + Datum - Weekday(Datum, 2)) - DateSerial(Year(4 + Datum - Weekday(Datum, 2)), 1, -6)) \ 7
Sheets(Monat).Cells(5, i) = KW
End If
Next
Next
End Sub
Aber - es wurde der angegebende Code des Fragenden falsch interpretiert und so kamen noch weitere Makro Codes zur Kalenderwoche (KW) zu stande. Ich konnte des Nachts nicht schlafen und erstellte dem Fragenden noch eine Funktion:
Option Explicit
Public Function DIN_KW(Datum As Date) As Variant
Dim KW As Date
If Day(Datum) = 1 Or Weekday(Datum) = vbMonday Then
KW = 4 + Datum - Weekday(Datum, 2)
DIN_KW = (KW - DateSerial(Year(KW), 1, -6)) \ 7
Else
DIN_KW = ""
End If
End Function
Dieses Beispiel zeigte, dass man auch mit einer Funktion den gewünschten Erfolg bekommt, aber ... ich hatte immer noch nicht verstanden, dass eine Funktion nur einen temporären Eintrag in die jeweilige Zelle schreiben kann. Ich leugnete das, denn in jeder Zelle lag ja ein Funktionsaufruf. Vom Fragenden kam noch einmal ein Code, welcher hier nicht erscheinen wird da er fehlerbehaftet war, und ich schaute mir den genauer an. Der Fragende hatte eigentlich recht. Man kann eine Funktion auch temporär einsetzen. Das setzt aber voraus, dass man eine Prozedur schreibt, welche erst einmal abklärt wann die Funktion gestartet werden soll. Bei Übereinstimmung wird die Funktion vom Code aufgerufen. Das Ergebnis war: Es ist in keiner Zelle mehr ein Funktionsaufruf vorhanden und es steht in jeder gewünschten Zelle die richtige Kalenderwoche. Hier kommt erst einmal das Schaubild und direkt im Anschluß kommt der Makro Code, welchen ich dazu geschrieben habe: | | D | E | F | G | | 3 | 01.01.2010 | 02.01.2010 | 03.01.2010 | 04.01.2010 | | 4 | Fr | Sa | So | Mo | | 5 | 53 | | | 1 |
Option Explicit
Public Function DIN_KW(Datum As Date) As Variant
Dim KW As Date
If Day(Datum) = 1 Or Weekday(Datum) = vbMonday Then
KW = 4 + Datum - Weekday(Datum, 2)
DIN_KW = (KW - DateSerial(Year(KW), 1, -6)) \ 7
End If
End Function
Sub KW_Test()
Dim loletzte As Long
Dim Monat As Byte
Dim i As Byte
For Monat = 1 To 2
loletzte = Sheets(Monat).Cells(3, Columns.Count).End(xlToLeft).Column
Sheets(Monat).Range(Sheets(Monat).Cells(5, 4), Sheets(Monat).Cells(5, loletzte)).ClearContents
For i = 4 To loletzte
If Day(Sheets(Monat).Cells(3, i)) = 1 Or Weekday(Sheets(Monat).Cells(3, i)) = vbMonday Then
Sheets(Monat).Cells(5, i) = DIN_KW(Sheets(Monat).Cells(3, i))
End If
Next
Next
End Sub
Gestartet wird in diesem Fall die Sub KW_Test(). Diese prüft ob es sich beim Datum auf den 12 Tabellenblättern um den ersten eines Monats, oder um einen Montag handelt. Ist dem der Fall so wird die Funktion mit: Sheets(Monat).Cells(5, i) = DIN_KW(Sheets(Monat).Cells(3, i)) gestartet. Ich sehe hier zwar nicht unbedingt den Sinn in der Tatsache, warum man eine Funktion mit einer Prozedur mischen sollte, jeder arbeitet anders, aber ich sehe hier das auch ich wieder etwas lernen durfte. Ich selber wußte nur, dass man einen Funktionsaufruf in eine Zelle schreibt.
|
VBA Makro Beispiele 
