Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1600to1604
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
VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 17:22:57
Peer
Hallo liebe VBA Gemeinde.
Ich sitze gerade an folgenden Problem.
Ich habe einen Jahres-Kalender auf mehrere Sheets verteilt und die Sheets mit den jeweiligen Monatsnamen benannt.
Ich habe den Kalender inzwischen so erstellt, dass mit Eingabe einer Ganzzahl als Jahr die Tage automatisch in die Sheets aktualisiert werden.
Desweiteren wird die Schriftart durch 2 bedingte Formatierungen des Sa (dünn rot), der So (dick rot) formatiert. Zusätzlich habe ich noch 2 weitere formatierte Bedingungen, die auf jeweils ein anderes Sheet über eine Matrix die Bedingungen suchen. Das wäre hier eine Matrix der Feiertage und eine Matrix der Ferien (hier Bayern). Bei erster Bedingung wird die Schriftart des Tages ebenfalls dick rot und bei zweiter Bedingung die Zellfarbe hell grün gefärbt.
Das klappt soweit ganz gut.
Nun ist meine Überlegung wie ich die Bedingungen alle in VBA realisieren kann.
Hat jemand eine Idee dazu?
Ich kann leider die Datei nicht uploaden, weil sie mehr als 400 kb hat.
LG
Peer

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 17:35:10
Sepp
Hallo Peer,
zuerst ein mal die Frage, warum du das Ganze per VBA lösen möchtest?
Gruß Sepp

AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 17:49:42
Peer
Hallo Sepp.
Ich merke, dass meine Datei sehr aufgebläht und langsam ist.
Vielleicht ist VBA die Lösung.
Und natürlich aus Interesse an VBA.
LG
Peer
AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 17:54:30
Hajo_Zi
Hallo Peer,
https://www.herber.de/bbs/user/118711.xls

Ich gebe keinen Dank für eine Rückmeldung, da ich durch solche Beiträge nicht meine Beitragszahl erhöhen muss.
Also ich schreibe keine Beiträge mit dem Betreff "Gerne u. Danke für die Rückmeldung....."
Rückmeldung ist ja in der Heutigen Zeit nicht üblich und die wenigen die eine Rückmeldung geben,
mögen mir das verzeihen, das kein Danke für eine Rückmeldung kommt.
Beiträge von Werner, Luc, robert und folgende lese ich nicht.
Anzeige
AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 18:21:58
Peer
Hallo Hajo.
Vielen Dank für den Link.
Leider sind meine VBA-Kenntnisse nicht so gut, dass ich daraus schlau werde.
In dieser Datei wird ein Kalender erzeugt und die Daten eingetragen.
Bei mir ist der Kalender schon vorhanden und nur B25 des Sheets "Parameter" wird mit einer Ganzzahl (zB 2018) geändert. Danach werden nur die Tage des Kalenders aktualisiert.
Bei deinem Link konnte ich den erzeugten Kalender nicht mit der Jahreszahl ändern, sondern musst wieder einen neuen Kalender erzeugen lassen.
Ich habe meine Datei leider nicht weiter reduzieren (mit Import/Export) können.
Ich weiß auch nicht, warum sie überhaupt so groß ist? Sonst hätte ich sie schon online geschickt.
LG
Peer
Anzeige
AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 18:00:07
Sepp
Hallo Peer,
dann lade die Datei hoch, sie muss ja nicht alle Monatsblätter enthalten, sondern nur eines und natürlich die Blätter mit den Feiertagen. Es sollte ein Monat mit Feiertagen sein (Mai?).
Gruß Sepp

AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 18:34:26
Peer
Hallo Sepp.
Ich habe jetzt mal nur zwei Monate in der Datei gelassen.
Bei dem Sheet "Gesamtstunden" sind logischerweise ein paar Felder ohne Bezug.
https://www.herber.de/bbs/user/118712.xlsm
Gruß
Peer
Anzeige
AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 19:59:23
Sepp
Hallo Peer,
teste mal. Einfach in 'Gesamtsumme' ein neues Jahr eingeben (per UserForm).
https://www.herber.de/bbs/user/118713.zip
Gezipt, da als .xlsm leicht zu groß.
Gruß Sepp

AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 20:18:25
Peer
Hi Sepp.
Es funktioniert sehr gut.
Danke.
Aber warum ist die Datei so groß? Auch bei dir ist sie groß?
Und warum funktioniert nicht mehr die Formel für "Zeit Soll" (Spalte W)?
LG
AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 20:26:52
Sepp
Hallo Peer,
400kb ist jetzt nicht wirklich groß mit 15 Tabellenblättern.
Deine Formeln hab ich mir natürlich nicht angeschaut, es ging ja um die Formatierung.
In B12:B42 steht nun jeweils das Datum und nicht mehr deine 'komische' WOCHENTAG() - Formel.
Für W12 lautet eine angepasste Formel z.b =Gesamtstunden!$C$20*(WOCHENTAG(B12;2)<6)
Gruß Sepp

Anzeige
AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 20:43:12
Peer
Hallo Sepp.
Du bist eben der Profi.
So ist es besser.
Danke nochmals dafür.
Ich habe noch eine andere Datei, die ebenfalls so viele Sheets hat, sie besitzt sogar mehr VBA, trotzdem ist sie nur 90kb gross.
Hmmm?!
Liegt es vielleicht doch an den Makros?
Muss ich am besten alles mit VBA lösen?
LG
Peer
AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 20:58:12
Sepp
Hallo Peer,
die paar Zeilen Code machen nichts aus, vielleicht solltest du mal alles in eine neue Mappe kopieren, allerdings nur die Zellen, nicht die kompletten Tabellenblätter. Beim Rumprobieren sammelt XL oft viel Datenmüll an.
Gruß Sepp

Anzeige
AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 21:02:58
Peer
Ich bin es nochmal Sepp.
Im VBA muss noch etwas falsch sein, denn die Feiertage, die in die Woche fallen (zB. Himmerlfahrt, Fronleichnam) werden nicht dick rot markiert, obwohl im Code angegeben.
Warum dies?
LG
Peer
AW: VBA bedingte Formatierung Wochen-/Feiertage
05.01.2018 21:27:14
Sepp
Hallo Peer,
kann ich nicht nachvollziehen!
Hier ein Auszug Mai 2018.
Mai

 BCDE
8KalendertagWochentagVerwendung/
Schichtnummer
9
10
11
1201Di 
1302Mi 
1403Do 
1504Fr 
1605Sa 
1706So 
1807Mo 
1908Di 
2009Mi 
2110Do 
2211Fr 
2312Sa 
2413So 
2514Mo 


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Gruß Sepp

Anzeige
Fehler gefunden.
05.01.2018 22:11:11
Sepp
Hallo Peer,
Ich habe den Fehler gefunden, lag n der Berechnung.
Ersetze den Code in Modul3 durch folgenden.
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

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

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)
      '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 inerhalb 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

Gruß Sepp

Anzeige
AW: Fehler gefunden.
05.01.2018 22:29:34
Peer
Hallo Sepp.
Fehler waren...
Application.Calculate (hat gefehlt)
varFeiertage = Application.Match(CLng(CDate(datDay)), Sheets("Feiertage").Range("Feiertage").Columns(2), 0) (CDate hat gefehlt)
Ist das so korrekt?
Danke für deine Mühe.
LG
Peer
AW: Fehler gefunden.
05.01.2018 22:31:56
Sepp
Hallo Peer,
.Calculate ja, beim Match reicht Clng(datDay) ohne das CDate().
Gruß Sepp

AW: Fehler gefunden.
05.01.2018 22:44:35
Peer
Hi Sepp.
Vielen Dank.
Gute Nacht.
Gruß
Peer
...gelöst
AW: VBA bedingte Formatierung Wochen-/Feiertage
08.01.2018 20:40:40
Peer
Hallo an alles, die es interessiert.
Ich habe Beverly's Code noch ein wenig verändert.
Ich habe alles in ein Modul gespeichert und daher nur einmal gespeichert.
Vorher habe ich jedem Blatt das Makro einer Schaltfläche zugeordnet. Daher musst ich den Code jedesmal dem Blatt abändern.
Nun wird das Makro immer beim aktiven Blatt gestartet.
Habe ich toll gemacht. ;-)
Sub druck_grau_Click()
Dim arrWerte()                          ' Variable für Array
Dim raZelle As Range                    ' Variable für die Zelle als Range
Dim loZaehler As Long                   ' Schleifenzähler
Dim loZaehler2 As Long                  ' Schleifenzähler
Dim rngDruckbereich As Range            ' Druckbereich
ActiveSheet.PageSetup.PrintArea = "$B$1:$O$50"
'Druckbereich festlegen
Set rngDruckbereich = Range("B1,O50")
'   Bildschirmaktualisierung aus
Application.ScreenUpdating = False
'   Blattschutz aufheben
ActiveSheet.Unprotect Password:=""
'   Ausführung in Tabelle1
With ActiveSheet
'       Schleife über jede Zelle des benutzten Bereichs
For Each raZelle In ActiveSheet.UsedRange
'           Zelle ist mit einer Füllfarbe  Weiß oder Schriftfarbe Rot formatiert
If raZelle.Interior.ColorIndex  2 Or raZelle.Font.Color = 255 Then
'               Array dynamisch erweitern
ReDim Preserve arrWerte(0 To 3, 0 To loZaehler)
'               Einlesen der Zelladresse in das Array
arrWerte(0, loZaehler) = raZelle.Address
'               Einlesen der Füllfarbe in das der Zelle in das Array
arrWerte(1, loZaehler) = raZelle.Interior.Color
arrWerte(2, loZaehler) = raZelle.Font.Color
arrWerte(3, loZaehler) = raZelle.Font.Bold
'               Füllfarbe der Zelle auf Weiß setzen
raZelle.Interior.ColorIndex = 2
'               Schriftschnitt auf nicht Fett setzen
raZelle.Font.Bold = False
'               Schriftfarbe auf Schwarz setzen
raZelle.Font.ColorIndex = 1
'               Schleifenzähler um 1 erhöhen
loZaehler = loZaehler + 1
End If
Next raZelle
'       Tabelle drucken
'        .PrintOut
'       Seitenvorschau öffnen
.PrintPreview
'       Drucker Auswahl Dialog öffnen
'         .Application.Dialogs(xlDialogPrint).Show
'       Schleife über alle Elemente des Arrays
For loZaehler2 = 0 To loZaehler - 1
'           Zurückübertragen der ausgelesenen Füllfarben
.Range(arrWerte(0, loZaehler2)).Interior.Color = arrWerte(1, loZaehler2)
.Range(arrWerte(0, loZaehler2)).Font.Color = arrWerte(2, loZaehler2)
.Range(arrWerte(0, loZaehler2)).Font.Bold = arrWerte(3, loZaehler2)
Next loZaehler2
End With
'   Blattschutz aktivieren
ActiveSheet.Protect Password:=""
'   Bildschirmaktualisierung ein
Application.ScreenUpdating = True
End Sub

Anzeige

319 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige