Office: VBA Wenn Funktion mit Widerholung

Hallo, ich bin neu im Forum und Hoffe auf Hilfe.

Ich habe vor ewigen Zeiten mal einen Kalender zur Schichtgruppen Planung erstellt. Es sind etliche Formeln zur Berechnung verschiedener
Zeitptionen hinterlegt. Da ich bisher aber immer die Wochentage mit
Wochenendfarbe und die Feiertage mit der Feiertagsfarbe immer manuell
neu machen muß, dacht ich mir, ich erstelle eine Automatik, die mir das per Klick automatisch macht. Zur Ansicht wie der Aufbau ist, habe ich unten eine Datei angehängt.

Jetzt bin ich soweit, dass die Wochentage und Feiertage automatisch eingetragen werden. Ich habe es auch geschafft, die Wochenenden (Sa,So) automatisch grau zu färben und die Feiertage automatisch rot
zu färben. Dafür nutze ich die grün markierten VBA Code Teile unten.

Mit den rot markierten Teilen wollte ich folgendes erreichen:

1. ist in Zelle B4 die Zellfarbe = grau, dann mache Zelle B5, B8-B14, B16,
B18-B19 auch grau

in meinem Fall ColorIndex 15

2. ist in Zelle B5 die Zellfarbe = rot, dann mache Zelle B8-B14, B16,
B18-B19 auch rot

in meinem Fall ColorIndex 3

Leider funktioniert das aber nicht so wie es soll.

Wenn mir jemand zeigen könnte wie sowas geht wäre klasse. Ich mache schon seit über einer Woche da rum und komme nicht weiter.

Genial wäre es natürlich wenn es Reihenbezogen funktionieren würde:

z.B.: Ist in den Zellen B4-B100 eine Zelle grau dann mache die jeweils
darunter liegenden Zellen 5, 8-14, 16, 18und 19 auch grau.

Dann müsse ich den Code nicht für alle Zellen neu schreiben und somit die VBA Datei klein halten.


So hier jetzt mein Code:

For Each Zelle In Range("B4:BJ4,B21:BK21,B38:BK38,B55:BL55,B72:BL72,B89:BL89,B106:AF106")
If (Weekday(Zelle.Value) = 1) Or (Weekday(Zelle.Value) = 7) And Zelle.Value <> 0 Then

Zelle.Interior.ColorIndex = 15

End If
If (Range("B4").Select = (Zelle.Interior.ColorIndex = 15)) Then

Range("B5,B8:B14,B16,B18:B19").Select
Selection.Interior.ColorIndex = 15

End If

Next

For Each Zelle In Range("B5:BJ5,B22:BK22,B39:BK39,B56:BL56,B73:BL73,B90:BL90,B107:AF107")

If ((Zelle.Value = Range("AJ109").Value) Or (Zelle.Value = Range("AJ110").Value) Or (Zelle.Value = Range("AJ111").Value) Or (Zelle.Value = Range("AJ112").Value) Or (Zelle.Value = Range("AJ113").Value) Or (Zelle.Value = Range("AJ114").Value) Or (Zelle.Value = Range("AJ115").Value) Or (Zelle.Value = Range("AJ116").Value) Or (Zelle.Value = Range("AP109").Value) Or (Zelle.Value = Range("AP110").Value) Or (Zelle.Value = Range("AP111").Value) Or (Zelle.Value = Range("AP112").Value) Or (Zelle.Value = Range("AP113").Value) Or (Zelle.Value = Range("AP114").Value) Or (Zelle.Value = Range("AP115").Value)) Then

With Zelle.Interior
.ColorIndex = 3

End With

End If
If (Range("B5").Select = (Zelle.Interior.ColorIndex = 3)) Then

Range("B8:B14,B16,B18:B19").Select
Selection.Interior.ColorIndex = 3

End If




Ich hoffe wie gesagt, dass mir jemand helfen kann.

Danke und Gruß

dienheimer

 

Hallo!

Warum nutzt du dafür nicht die Bedingte Formatierung?
Genau dafür ist sie doch gemacht.

 

Hallo,

bei der verwendeten Excel Version sind nur drei bedingte Formatierungen
pro Zelle möglich. Diese sind bereits für andere Funktionen in gebrauch.

Gruß

Markus

 

Hallo!

Verstehe!
Dann probier' mal sowas:

Code:

Sub Wochenende()
Dim Zelle As Range, Faerbe As Range
For Each Zelle In Range("B4:N4")
If Weekday(Zelle) = 7 Or Weekday(Zelle) = 1 Then
Set Faerbe = Union(Zelle.Resize(2, 1), Zelle.Offset(4, 0).Resize(7, 1), Zelle.Offset(12, 0), Zelle.Offset(14, 0).Resize(2, 1))
Faerbe.Interior.ColorIndex = 15
End If
Next
End Sub

 

Hey, super!

So funktioniert es.




Vielen Dank

Gruß Markus

 

Hallo nochmal.

Nun ist ein neues Problem aufgetreten:

Die automatische Generierung fragt auch Schaltjahre ab.
Wir der 29. Feb. nicht benötigt wird die Schriftfarbe automatisch weiss
uns somit nicht zu sehen.
Die Formeln in den Zellen geben Sa und 0. Jan. aus.

Wenn ich jetzt das formatierungs VBA ausführe werden logisch alle
Zellen grau gefärbt.

Die Idee war jetzt das ganze wie folgt zu ergänzen:

Wenn Schriftfarbe in Zelle BJ5 = weiss dann markiere die Zellen BJ4 - BJ5 und BJ8 - BJ14 und BJ16 und BJ18 - BJ19. Färbe die zellen weiss.


Ich hab´s probiert; leider ohne erfolg.


Unten ein Ausschnitt zum anschauen.



Für Hilfe bin ich sehr dankbar.


Gruß Markus




Achso, da hätte ich noch ne Kleinigkeit.

Ich möchte auf ein zweites Tabellenblatt nur die Formatierung
der Januarzellen übertragen.

Dazu habe ich auf dem Blatt "Januar" eine Befehlsschaltfläche gesetzt
und wollte folgenden Code ausführen:

Private Sub aktujan_Click()

Sheets("Eingabe").Select
Range("B4:AF19").Select
Selection.Copy
Sheets("Januar").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

End Sub

Die Zeile: Range("B4:AF19").Select
kann aber nicht ausgeführt werden!

Ich verstehe nicht ganz warum.

Eine Lösungshilfe hierfür wäre natürlich auch klasse.


Gruß Markus