Funktion in Makro einbauen



Excel-Version: 2000
nach unten

Betrifft: Funktion in Makro einbauen
von: Rainer Quaas
Geschrieben am: 10.05.2002 - 21:55:54

Hallo Excel-User,

Die unten aufgeführte Funktion zur Berechnung der Kalenderwoche (KW) aus einem Datum möchte ich über ein Makro aufrufen.

Dabei sollen selektierte Zellen, die ein Datum enthalten

1. direkt in die KW umgewandelt werden

oder

2. in die rechte Nachbarzelle (ein anderes Makro) soll die KW eingetragen werden.


Mein Makro beginn bisher folgendermaßen:


Sub Datum_in_KW()
Dim cell As Range

For Each Cell In Selection

'hier sollte der Code berücksichtigen, ob die Zelle leer ist
'wenn ja, dann nächste Zelle

'hier sollte der Code berücksichtigen, ob die Zelle im Datumsformat vorliegt
'wenn nicht, nächste Zelle

'jetzt soll die Umwandlung in KW erfolgen

Next Cell

End Sub


Nun die Funktion

'Kalenderwoche aus Datum

~begin~
Function din_kw(datum As Date) As Integer
Dim i, j, k As Integer
i = datum - DateSerial(Year(datum), 1, 1)
k = Weekday(DateSerial(Year(datum), 1, 1), vbMonday)
j = Int((i - (8 - k)) / 7) + 1
If k <= 4 Then j = j + 1
If j = 0 Then
j = din_kw(DateSerial(Year(datum) - 1, 12, 31))
ElseIf j = 53 And Weekday(DateSerial(Year(datum), 12, 31), vbMonday) <= 3 Then
j = 1
End If
din_kw = j
End Function
~end~

Gruß Rainer

nach oben   nach unten

Re: Funktion in Makro einbauen
von: Hajo
Geschrieben am: 11.05.2002 - 08:04:59

Hallo Rainer

Sub Datum_in_KW()
    Dim cell As Range
    Dim tmp
    For Each cell In Selection
    'hier sollte der Code berücksichtigen, ob die Zelle leer ist
    'wenn ja, dann nächste Zelle
    'hier sollte der Code berücksichtigen, ob die Zelle im Datumsformat vorliegt
    'wenn nicht, nächste Zelle
    'jetzt soll die Umwandlung in KW erfolgen
        If IsDate(cell.Value) Then
            tmp = DateSerial(Year(cell + (8 - Weekday(cell)) Mod 7 - 3), 1, 1)
            cell = ((cell - tmp - 3 + (Weekday(tmp) + 1) Mod 7)) \ 7 + 1
        End If
    Next cell
End Sub

Gruß Hajo


nach oben   nach unten

Re: kleine Korrektur
von: Rainer Quaas
Geschrieben am: 11.05.2002 - 10:50:37

Hallo Hajo,

vielen Dank für die Hilfe.

Bei Deinen vielen Antworten hier im Forum hast Du übersehen, daß in der Ursprungszelle noch das Datumsformat steht. Daraus folgt, dass die "Kalenderzahl" natürlich wieder in ein Datum umgewandelt wird. Daher habe ich Deinen Code minimal verändert.

Für den Fall, daß die Kalenderwoche in die Nachbarzelle eingetragen werden soll, kann man das zweite Makro benutzen


Sub Datum_der_Ursprungzelle_in_KW()
    Dim cell As Range
    Dim tmp
    For Each cell In Selection
        If IsDate(cell.Value) Then
            tmp = DateSerial(Year(cell + (8 - Weekday(cell)) Mod 7 - 3), 1, 1)
            cell = ((cell - tmp - 3 + (Weekday(tmp) + 1) Mod 7)) \ 7 + 1
            cell.NumberFormat = "0 "" KW"""
        End If
    Next cell
End Sub


Sub Datum_in_KW_in_Nachbarzelle()
    Dim cell As Range
    Dim tmp
    For Each cell In Selection
        If IsDate(cell.Value) Then
            tmp = DateSerial(Year(cell + (8 - Weekday(cell)) Mod 7 - 3), 1, 1)
            cell.Offset(0, 1).Value = ((cell - tmp - 3 + (Weekday(tmp) + 1) Mod 7)) \ 7 + 1
            cell.Offset(0, 1).NumberFormat = "0 "" KW"""
        End If
    Next cell
End Sub

Gruß Rainer


 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Funktion in Makro einbauen"