Date und SUM

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Date und SUM

04.11.2005 15:58:03

UweD

AW: Date und SUM

04.11.2005 19:02:06

egon

Hallo
Hier mal was gebasteltes.
Alles in ein Modul kopieren. (Teile2 und 3 aus unbekannter Quelle)

Option Explicit
Sub Datum()
    Dim Z1, S1, Jahr%, Monat%, AZ%, Letzter%, i%, FT$
    Z1 = 12 ' ab Zeile 12
    S1 = 1 'Spalte A
    Jahr = InputBox("Bitte Jahr eingeben", "Egon's Superprogramm", Year(Date))
    Monat = InputBox("Bitte Monat eingeben", "Egon's Superprogramm", Month(Date))
    AZ = InputBox("tägliche Regelarbeitszeit", "Egon's Superprogramm", 8)
    Letzter = Day(DateSerial(Jahr, Monat + 1, 0))
    ActiveSheet.Cells.Clear 'alles löschen
    For i = 1 To Letzter
        With ActiveSheet.Cells(i + Z1 - 1, S1)
            .NumberFormat = "DDD. DD"
            .Value = DateSerial(Jahr, Monat, i)
            If WorksheetFunction.Weekday(.Value, 2) > 5 Then
                .Font.ColorIndex = 50 'grün
            End If
            FT = FeierTag(.Value, 0)
            If FT <> "" Then
                .Font.ColorIndex = 6 'gelb
                .Offset(0, 1).Value = FT
            End If
                .Offset(0, 2).Value = AZ
                .Offset(0, 4).FormulaR1C1 = "=RC[-1]-RC[-2]"
        End With
        With ActiveSheet.Cells(Z1 + Letzter, S1)
            .Offset(1, 0).Value = "Summen"
            .Offset(1, 2).FormulaR1C1 = "=SUM(R[-" & Letzter + 1 & "]C:R[-2]C)"
            .Offset(1, 3).FormulaR1C1 = "=SUM(R[-" & Letzter + 1 & "]C:R[-2]C)"
            .Offset(1, 4).FormulaR1C1 = "=SUM(R[-" & Letzter + 1 & "]C:R[-2]C)"
        End With
    Next
    MsgBox "Tatsächliche Arbeitszeiten sind noch zu ergänzen"
End Sub
Public Function FeierTag(Datum As Date, N As Boolean) As String
    Dim Jahr As Integer
    Jahr = Year(Datum)
    If (Jahr > 1904) And (Jahr < 2100) Then
        Select Case Format$(Datum, "dd.mm")
            ' Gesetzliche Feiertage
            Case "01.01": FeierTag = "Neujahr"
            Case "06.01": FeierTag = "Heilige Drei Könige"
            Case "01.05": FeierTag = "Tag der Arbeit"
            Case "15.08":  FeierTag = "Mariä Himmelfahrt"
            Case "03.10": FeierTag = "Tag der Deutschen Einheit"
            Case "31.10": FeierTag = "Reformationstag"
            Case "01.11": FeierTag = "Allerheiligen"
            Case "24.12": FeierTag = "Heiligabend"
            Case "25.12": FeierTag = "1. Weihnachtsfeiertag"
            Case "26.12": FeierTag = "2. Weihnachtsfeiertag"
            Case "31.12": FeierTag = "Sylvester"
            Case Else
                ' Bewegliche Feste:
                Select Case Datum - OsterSonntag(Datum)
                    Case -52: FeierTag = "Weiberfastnacht"
                    Case -48: FeierTag = "Rosenmontag"
                    Case -2:  FeierTag = "Karfreitag"
                    Case 0:  FeierTag = "Ostersonntag"
                    Case 1:  FeierTag = "Ostermontag"
                    Case 39:  FeierTag = "Christi Himmelfahrt"
                    Case 49:  FeierTag = "Pfingstsonntag"
                    Case 50:  FeierTag = "Pfingstmontag"
                    Case 60:  FeierTag = "Fronleichnam"
                    Case Else
                        If Datum = CDate("25.12." & Jahr) - Weekday("25.12." & Jahr, _
                        vbMonday) - 32 Then
                            FeierTag = "Buß- und Bettag"
                        Else
                            If N = True Then
                                FeierTag = "gewöhnlicher " & Format$(Datum, "DDDD") ' Kein Feiertag
                            ElseIf N = False Then
                                FeierTag = vbNullString ' Kein Feiertag
                            End If
                        End If
                End Select
        End Select
    Else: FeierTag = vbNullString
    End If
  End Function
Public Function OsterSonntag(Datum As Date) As Date
    Dim A As Integer, D As Integer, E As Integer, Jahr As Integer
    Jahr = Year(Datum)
    If (1904 < Jahr) And (Jahr < 2100) Then  ' Datum zulässig ?
        A = Jahr Mod 19
        D = (19 * A + 24) Mod 30
        E = (2 * (Jahr Mod 4) + 4 * (Jahr Mod 7) + 6 * D + 5) Mod 7
        OsterSonntag = CDate(DateSerial(Jahr, 3, 22 + D + E))
        If Month(OsterSonntag) = 4 Then
            If Day(OsterSonntag) = 26 Or (Day(OsterSonntag) = 25 And E = 6 And A > 10) Then
                OsterSonntag = OsterSonntag - 7
            End If
        End If
    End If
End Function

Gruß UweD
(Rückmeldung wäre schön)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Date und SUM

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread