Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 09:31:31
Bild "In Zelle platzieren"
25.04.2024 09:23:47
Spalten in Kreuztabelle hinzufügen/löschen je nach Vorgabe
25.04.2024 08:41:49
VBA: Probleme mit pdftk zum Zusammenfügen
25.04.2024 00:42:03
Listbox mit gefilterten Daten füllen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1100to1104
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1100to1104
1100to1104
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Feiertage in Excel (VBA)

Feiertage in Excel (VBA)
Uwe
Guten Morgen zusammen,
einmal mehr eine Frage, die mich beschäftigt.
Mit Hilfe der folgenden Routine gelingt es mir ganz gut, Feiertage innerhalb eines Kalenderjahres in einem gesonderten Tabellenblatt ("Feiertage") darzustellen.
Option Explicit 
Sub Ostersonntag()
On Error Resume Next
Dim intjahr As Integer
Dim BegDatum, y As Date
Dim x As Integer
Application.ScreenUpdating = False
BegDatum = Worksheets("Zeitdaten").Range("A1")
Worksheets("Zeitdaten").Select
Range("A37").Value = Format(Year(BegDatum), "0000")
intjahr = Worksheets("Zeitdaten").Range("A37")
x = (((255 - 11 * (intjahr Mod 19)) - 21) Mod 30) + 21
y = DateSerial(intjahr, 3, 1) + x + (x > 48) + 6 - ((intjahr + intjahr \ 4 + x + (x > 48) + 1)  _
Mod 7)
Worksheets("Feiertage").Range("A1") = DateSerial(intjahr, 1, 1)
Worksheets("Feiertage").Range("A2") = y - 2
Worksheets("Feiertage").Range("A3") = y
Worksheets("Feiertage").Range("A4") = y + 1
Worksheets("Feiertage").Range("A5") = DateSerial(intjahr, 5, 1)
Worksheets("Feiertage").Range("A6") = y + 39
Worksheets("Feiertage").Range("A7") = y + 49
Worksheets("Feiertage").Range("A8") = y + 50
Worksheets("Feiertage").Range("A9") = y + 60
Worksheets("Feiertage").Range("A10") = DateSerial(intjahr, 10, 3)
Worksheets("Feiertage").Range("A11") = DateSerial(intjahr, 11, 1)
Worksheets("Feiertage").Range("A12") = DateSerial(intjahr, 12, 25)
Worksheets("Feiertage").Range("A13") = DateSerial(intjahr, 12, 26)
Worksheets("Feiertage").Range("A15") = y - 48
Worksheets("Feiertage").Range("A16") = DateSerial(intjahr, 12, 24)
Worksheets("Feiertage").Range("A17") = DateSerial(intjahr, 12, 31)
Worksheets("Feiertage").Range("B1") = "Neujahr"
Worksheets("Feiertage").Range("B2") = "Karfreitag"
Worksheets("Feiertage").Range("B3") = "Ostersonntag"
Worksheets("Feiertage").Range("B4") = "Ostermontag"
Worksheets("Feiertage").Range("B5") = "Maifeiertag"
Worksheets("Feiertage").Range("B6") = "Christi Himmelfahrt"
Worksheets("Feiertage").Range("B7") = "Pfingstsonntag"
Worksheets("Feiertage").Range("B8") = "Pfingstmontag"
Worksheets("Feiertage").Range("B9") = "Fronleichnam"
Worksheets("Feiertage").Range("B10") = "Tag der deutschen Einheit"
Worksheets("Feiertage").Range("B11") = "Allerheiligen"
Worksheets("Feiertage").Range("B12") = "1. Weihnachtstag"
Worksheets("Feiertage").Range("B13") = "2. Weihnachtstag"
Worksheets("Feiertage").Range("B15") = "Rosenmontag"
Worksheets("Feiertage").Range("B16") = "Heiligabend"
Worksheets("Feiertage").Range("B17") = "Sylvester"
Application.ScreenUpdating = True
End Sub
Mit Hilfe dieser Daten "vergleiche" ich nur innerhalb einer anderen Routine, ob denn ein Datum des aktuellen Monats (Zellen "A5:A35" des Arbeitsblattes "Abrechnung") mit einem dieser Daten im Blatt "Feiertage" identisch ist. Wenn ja, kopiere ich Daten aus Zellen "D5:D35" in "Z5:Z35".
Wie gesagt, so weit "passt" das.
Nur habe ich irgendwie den Eindruck, das diese Vorgehensweise vereinfacht werden kann/soll. Hierbei würde ich gerne auf dieses zusätzliche Tabellenblatt ("Feiertage") verzichten und den Vergleich, ob den Feiertage im aktuellen Monat anfallen, direkt im Modul erledigen. Wenn wirklich Feiertage anfallen, sollen denn die Daten aus "D5:D35" direkt in "Z5:Z35" kopiert werden.
Keine Ahnung, wie das gehen soll. Hat den wer von Euch dazu ne Idee? Einmal mehr nur via VBA
Besten Dank für Eure Überlegungen.
Gruß
Uwe

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Feiertage in Excel (VBA)
15.09.2009 08:41:24
fcs
Hallo Uwe,
du kannst es als benutzerdefinierte Funktion aufbauen.
Gruß
Franz 

FormelBeispiel:
=WENN(Feiertag(C2)="";TEXT(C2;"TTT");Feiertag(C2))
Function Feiertag(Datum As Date) As String
On Error Resume Next
Dim intjahr As Integer
Dim x As Integer, y As Date
Dim intI As Integer, arrDatum(1 To 20)  As Date, arrText(1 To 20) As String
intjahr = VBA.Year(Datum)
'Ostertag ermitteln
x = (((255 - 11 * (intjahr Mod 19)) - 21) Mod 30) + 21
y = DateSerial(intjahr, 3, 1) + x + (x > 48) + 6 - _
((intjahr + intjahr \ 4 + x + (x > 48) + 1) Mod 7)
intI = 0
intI = intI + 1: arrDatum(intI) = DateSerial(intjahr, 1, 1): arrText(intI) = "Neujahr"
intI = intI + 1: arrDatum(intI) = y - 2: arrText(intI) = "Karfreitag"
intI = intI + 1: arrDatum(intI) = y: arrText(intI) = "Ostersonntag"
intI = intI + 1: arrDatum(intI) = y + 1: arrText(intI) = "Ostermontag"
intI = intI + 1: arrDatum(intI) = DateSerial(intjahr, 5, 1): arrText(intI) = "Maifeiertag"
intI = intI + 1: arrDatum(intI) = y + 39: arrText(intI) = "Christi Himmelfahrt"
intI = intI + 1: arrDatum(intI) = y + 49:  arrText(intI) = "Pfingstsonntag"
intI = intI + 1: arrDatum(intI) = y + 50: arrText(intI) = "Pfingstmontag"
intI = intI + 1: arrDatum(intI) = y + 60: arrText(intI) = "Fronleichnam"
intI = intI + 1
arrDatum(intI) = DateSerial(intjahr, 10, 3):  arrText(intI) = "Tag der deutschen Einheit"
intI = intI + 1
arrDatum(intI) = DateSerial(intjahr, 11, 1):  arrText(intI) = "Allerheiligen"
intI = intI + 1
arrDatum(intI) = DateSerial(intjahr, 12, 25):  arrText(intI) = "1. Weihnachtstag"
intI = intI + 1
arrDatum(intI) = DateSerial(intjahr, 12, 26):  arrText(intI) = "2. Weihnachtstag"
intI = intI + 1
arrDatum(intI) = y - 48:  arrText(intI) = "Rosenmontag"
intI = intI + 1
arrDatum(intI) = DateSerial(intjahr, 12, 24):  arrText(intI) = "Heiligabend"
intI = intI + 1
arrDatum(intI) = DateSerial(intjahr, 12, 31):  arrText(intI) = "Sylvester"
For intI = LBound(arrDatum) To intI
If Datum = arrDatum(intI) Then
Feiertag = arrText(intI)
End If
Next
End Function

Anzeige
Vergebl Liebesmüh', Franz,...
15.09.2009 09:15:37
Luc:-?
...der Knabe kann für sein Jhdwerk keine Formeln gebrauchen — und ob er schon soweit ist, eine udF in eine Subroutine einbauen zu können... ;-)
Gruß Luc :-?
AW: Datum, Feiertage kennzeichnen
15.09.2009 14:25:31
fcs
Hallo Luc,
die Function kann man natürlich auch in einer Sub-Routine aufrufen, wenn man's kann.
Gruß
Franz
Beispiel: 
Sub Feiertag_einfuegen()
Dim Zeile As Long, x As Long, y As Long, wks As Worksheet
Set wks = ActiveSheet
With wks
'in Spalte A (1) stehen Datumsangaben, in Spalte B (2) wird Wochentags- _
kürzel oder Feiertag eingetragen
x = 10: y = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(x, 2), .Cells(y, 2)).ClearContents
For Zeile = x To y
'Zelle auf Datum prüfen
If IsDate(.Cells(Zeile, 1)) Then
'Prüfen ob Feiertag
If Feiertag(Datum:=.Cells(Zeile, 1).Value) = "" Then
'Wochentag einfügen
.Cells(Zeile, 2).Value = Format(.Cells(Zeile, 1), "ddd")
Else
'Feiertag einfügen
.Cells(Zeile, 2).Value = Feiertag(.Cells(Zeile, 1).Value)
End If
End If
Next
End With
End Sub
Und als Extra eine Funktion, die bundeslandspezifisch auf Feiertag prüft + ein paar Sondertage. 
Function FeiertagDE(Datum As Date, Optional Bundesland As String, _
Optional bolKath As Boolean, Optional bolRosenmontag As Boolean, _
Optional bolDez24 As Boolean, Optional bolDez31 As Boolean, _
Optional bolAug08 As Boolean, Optional bolFronleichnam As Boolean) As String
'##Ersteller fcs, Datum: 2009-09-15
'Funktion ermittelt für das Datum, ob es auf einem Feiertag liegt und gibt den _
Feiertag zurück
'Option bolKatk - Marie Himmelfahrt für Bayern in überwiegend katholischen Gemeinden
'Option bolFronleichnam - für Sachsen und Thüringen gem spezieller Regelung
'Beispiel für Funktionsaufruf:
' strFeiertag = FeiertagDE(Datum:=.Cells(Zeile, 1).Value, Bundesland:="BY", bolKath:=True)
'Abkürzungen für Bundesland
'BW=Baden-Württemberg         NI=Niedersachsen
'BY=Bayern                    NW=Nordrhein -Westfalen
'BE=Berlin                    RP=Rheinland -Pfalz
'BB=Brandenburg               SL=Saarland
'HB=Bremen                    SN=Sachsen
'HH=Hamburg                   ST=Sachsen -Anhalt
'HE=Hessen                    SH=Schleswig -Holstein
'MV=Mecklenburg -Vorpommern   TH=Thüringen
'Feiertage                    BW BY BE BB HB HH HE MV NI NW RP SL SN ST SH TH
'Neujahrstag (01.01.)          x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x
'Hl. Drei Könige (06.01.)      x  x                             x
'Karfreitag                    x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x
'Ostermontag                   x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x
'Tag der Arbeit (01.05.)       x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x
'Christi Himmelfahrt           x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x
'Pfingstmontag                 x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x
'Fronleichnam                  x  x              x        x  x  x  1        1
'Mariä Himmelfahrt (15.08.)       k                             x
'Tag der dt. Einheit (03.10.)  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x
'Reformationstag (31.10.)               x           x              x  x     x
'Allerheiligen (01.11.)        x  x                       x  x  x
'Buß- u. Bettag                                                    x
'1.Weihnachtstag (25.12.)      x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x
'2. Weihnachtstag (26.12)      x  x  x  x  x  x  x  x  x  x  x  x  x  x  x  x
'x  bedeutet gesetzlicher Feiertag
'k  bedeutet gesetzlicher Feiertag in Gemeinden mit überwiegend katholischer _
Bevölkerung
'1  Sonderregelungen in SN und TH
On Error GoTo Fehler
Dim intJahr As Integer, Tag As Long
Dim x As Integer, Ostern As Date
Dim intI As Integer, arrDatum(1 To 20)  As Date, arrText(1 To 20) As String
intJahr = VBA.Year(Datum)
'Ostertag ermitteln
x = (((255 - 11 * (intJahr Mod 19)) - 21) Mod 30) + 21
Ostern = DateSerial(intJahr, 3, 1) + x + (x > 48) + 6 - _
((intJahr + intJahr \ 4 + x + (x > 48) + 1) Mod 7)
'Feiertage Bundesweit
intI = 0
intI = intI + 1: arrDatum(intI) = DateSerial(intJahr, 1, 1): arrText(intI) = "Neujahr"
intI = intI + 1: arrDatum(intI) = Ostern - 2: arrText(intI) = "Karfreitag"
intI = intI + 1: arrDatum(intI) = Ostern: arrText(intI) = "Ostersonntag"
intI = intI + 1: arrDatum(intI) = Ostern + 1: arrText(intI) = "Ostermontag"
intI = intI + 1: arrDatum(intI) = DateSerial(intJahr, 5, 1): arrText(intI) = "Maifeiertag"
intI = intI + 1: arrDatum(intI) = Ostern + 39: arrText(intI) = "Christi Himmelfahrt"
intI = intI + 1: arrDatum(intI) = Ostern + 49:  arrText(intI) = "Pfingstsonntag"
intI = intI + 1: arrDatum(intI) = Ostern + 50: arrText(intI) = "Pfingstmontag"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 10, 3):  arrText(intI) = "Tag der deutschen Einheit"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 12, 25):  arrText(intI) = "1. Weihnachtstag"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 12, 26):  arrText(intI) = "2. Weihnachtstag"
'Feiertage in einzelnen Bundesländern
'Heilige 3 Könige (1.11.)
Select Case Bundesland
Case "BW", "BY", "SL"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 11, 1):  arrText(intI) = "Hl. 3 Könige"
End Select
'Fronleichnam
Select Case Bundesland
Case "BW", "BY", "HE", "NW", "RP", "SL"
intI = intI + 1
intI = intI + 1: arrDatum(intI) = Ostern + 60: arrText(intI) = "Fronleichnam"
Case "ST", "TH"
If bolFronleichnam = True Then
intI = intI + 1
intI = intI + 1: arrDatum(intI) = Ostern + 60: arrText(intI) = "Fronleichnam"
End If
End Select
'Marie Himmelfahrt (15.08.)
Select Case Bundesland
Case "SL"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 11, 1):  arrText(intI) = "Marie Himmelfahrt"
Case "BY"
If bolKath = True Then
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 11, 1):  arrText(intI) = "Marie Himmelfahrt"
End If
End Select
'Allerheiligen (01.11.)
Select Case Bundesland
Case "BW", "BY", "NW", "RP", "SL", "SN"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 11, 1):  arrText(intI) = "Allerheiligen"
End Select
'Buß- und Bettag  (Mittwoch vor dem 23. November)
Select Case Bundesland
Case "SN"
intI = intI + 1
Tag = 22
Do Until VBA.Weekday(DateSerial(intJahr, 11, Tag)) = vbWednesday
Tag = Tag - 1
Loop
arrDatum(intI) = DateSerial(intJahr, 11, Tag):  arrText(intI) = "Buß und Bettag"
End Select
'Sonstige arbeitsfreie Tage /Feiertage
'Rosenmontag
If bolRosenmontag = True Then
intI = intI + 1
arrDatum(intI) = Ostern - 48:  arrText(intI) = "Rosenmontag"
End If
'8. August - Friedenstag Augsburg
If bolAug08 = True Then
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 8, 8):    arrText(intI) = "Friedenstag"
End If
'24. Dezember (Heiligen Abend)
If bolDez24 = True Then
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 12, 24):  arrText(intI) = "Heiligabend"
End If
'31. dezember (Sylvester)
If bolDez31 = True Then
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 12, 31):  arrText(intI) = "Sylvester"
End If
'Eingabe-Datum prüfen
For intI = LBound(arrDatum) To intI
If Datum = arrDatum(intI) Then
FeiertagDE = arrText(intI)
Exit For
End If
Next
Err.Clear
Fehler:
With Err
If .Number  0 Then
FeiertagDE = "#Fehler!"
End If
End With
End Function

Anzeige
AW: Korrektur Hl. 3 Könige, Marie Himmelfahrt
15.09.2009 15:52:30
fcs
An alle Interessenten,
In meiner Funktion sind die Monats und Tagesange für Heilige 3 Könige und Marie Himmelfahrt falsch.
Bitte korrigieren.
Gruß
Franz
Korrektur: 
'Feiertage in einzelnen Bundesländern
'Heilige 3 Könige (1.11.)
Select Case Bundesland
Case "BW", "BY", "SL"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 1, 6):  arrText(intI) = "Hl. 3 Könige"
End Select
'Marie Himmelfahrt (15.08.)
Select Case Bundesland
Case "SL"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 8, 15):  arrText(intI) = "Marie Himmelfahrt"
Case "BY"
If bolKath = True Then
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 8, 15):  arrText(intI) = "Marie Himmelfahrt"
End If
End Select

Anzeige
Damit du doch noch'n PositivFeedback hast,...
20.09.2009 02:41:59
Luc:-?
...Franz,
kann ich dir mitteilen, dass ich deine Fktt anzuwenden gedenke (evtl nur vom Prinzip her, muss mal sehen), obwohl dir ja ulkigerweise bei den Ausgabetexten, die ich momentan nicht brauche, im Ggsatz zu deiner Rem-Vorlage ein Schreibfehler und bei der Korrektur ein falsches Datum unterlaufen/-gekommen ist... ;-)
Gruß Luc :-?
PS: Übrigens, so etwas verstehe ich unter einer allgemeinen Lösung — udFktt sind dafür geradezu prädestiniert. Nicht immer diese ewigen Makro-Insellösungen... ;-)
Eben...! Gruß owT
16.09.2009 05:10:58
Luc:-?
:-?

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige