Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA wenn Feiertag dann Wert in Zelle 0:00

VBA wenn Feiertag dann Wert in Zelle 0:00
10.01.2018 20:25:56
Peer
Hallo und Guten Abend.
Ich hänge gerade an folgender Aufgabe.
Ich möchte gern in Spalte W Bereich W12:W42 den Wert 0:00 eintragen, wenn in der jeweiligen Zeile in Spalte C ein Wochenfeiertag ist.
Die Feiertage habe ich in einer extra Tabelle geordnet. Diese Tabelle sollte die Referenz sein.
Dazu haben wir hier schon einige geholfen, mein Projekt mit VBA auf die Beine zu stellen.
Natürlich versuche ich auch, selbst beizutragen.
Nur klappte es nicht immer.
Vielleicht kann mir jemand helfen.
Danke im Voraus
Die Datei ist zu groß, deshalb dieser Link.
https://www.dropbox.com/s/ohcn5pdg4bvcsiy/neu_Vorlage_Erfassungsbeleg_backup3.xlsm?dl=0
LG
Peer

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA wenn Feiertag dann Wert in Zelle 0:00
10.01.2018 20:30:30
Peer
Hier den bisherigen Code...
Option Explicit
Sub neuesJahr()
Dim lngYear As Long, lngMonth As Long, lngDay As Long
Dim datDay As Date, varFerien As Variant, varFeiertage As Variant
Dim bolHolyday As Boolean
On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
frm_Jahr.Show
Application.Calculate 'Fehler gefunden
ActiveWorkbook.Unprotect
lngYear = Sheets("Gesamtstunden").Range("B25")
For lngMonth = 1 To 12
With Sheets(Format(DateSerial(lngYear, lngMonth, 1), "mmmm"))
.Unprotect
'Zellen leeren und Formate entfernen
With .Range("B12:C42")
.ClearContents
.Font.ColorIndex = xlAutomatic
.Font.Bold = False
.Interior.ColorIndex = xlNone
End With
.Range("D12:E42,G12:L42,P12:U42,X12:X42").ClearContents
'vom 1.Tag des Monats bis zum letzten
For lngDay = 1 To Day(DateSerial(lngYear, lngMonth + 1, 0))
'Datum ermitteln
datDay = DateSerial(lngYear, lngMonth, lngDay)
'In 'Feietage' das Datum suchen
varFeiertage = Application.Match(CLng(CDate(datDay)), Sheets("Feiertage").Range(" _
Feiertage").Columns(2), 0) 'Fehler gefunden
'In 'Ferien' das Datum suchen - kleiner oder gleich
varFerien = Application.Match(CLng(datDay), Sheets("Ferien").Range("Bayern").Columns(1), _
1)
bolHolyday = False
'Wenn Datum gefunden, dann vergeichen ob das Enddatum auch im Bereich liegt
If IsNumeric(varFerien) Then
bolHolyday = Sheets("Ferien").Range("Bayern").Cells(varFerien, 2) >= datDay
End If
'Die Datumszellen
With .Range(.Cells(lngDay + 11, 2), .Cells(lngDay + 11, 3))
.Value = datDay 'Datum eintragen
'Wenn Wochentag größer Freitag, dann rote Schriftfarbe
If Weekday(datDay, vbMonday) > 5 Or IsNumeric(varFeiertage) Then .Font.ColorIndex = 3
'Wenn Wochentag ist Sonntag oder es ist ein Feiertag, dann Fettschrift
.Font.Bold = Weekday(datDay, vbMonday) = 7 Or IsNumeric(varFeiertage)
'Wenn Datum innerhalb eines Ferienbereiches liegt, dann Hintergrund Hellgrün
If bolHolyday Then .Interior.Color = RGB(235, 241, 222)
End With
Next
.Protect
End With
Next
ActiveWorkbook.Protect
Sheets("Januar").Select
Range("D12").Select
ErrorHandler:
If Err.Number  0 Then
MsgBox "Fehler in Modul3" & vbLf & vbLf & "Prozedur:" & vbTab & "neuesJahr" & vbLf & _
"Nummer:" & vbTab & Err.Number & vbLf & "Meldung:" & vbTab & Err.Description & vbLf & _
IIf(Erl, "Zeile:" & vbTab & Erl, ""), vbExclamation, "Fehler!"
Err.Clear
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.AskToUpdateLinks = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Anzeige

488 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige