Best. Tag in restl. Monaten des Jahres farblich makieren

[Sagulum]

Hallo

Habe mir einen kl. Behelfskalender erstellt. In diesem möchte ich, ab den Tag an dem ich in den Kalender klicke, alle Tage in den restlichen Monaten des Jahres, die mit dem Tag z.B. 07 in Zelle "D6" übereinstimmen, farblich makiert werden. Die Makierung sollte in der Zeile liegen in die ich klicke. Habe da mal eine Beispieldatei mit hochgeladen.
Würde mich freuen wenn jemand eine Idee hat.

Viele Grüße das Sagulum

[Elex]

Hi

Kann man machen. Wäre es aber nicht übersichtlicher nur diese Tage(Spalten) einzublenden und die anderen dann aus.

Gruß Elex

[Stephan]

Hallo Sagulum,

meinst du so?

Freundlichen Gruß
Stephan

Ergänzung:

Bei Doppelklick auf dein Beginndatum (z.B. Zelle L6) wird dieser Tag nach Zelle D6 übernommen und über bed. Formatierung werden in den Folgemonaten diese Tage eingefärbt.

[Elex]

Hi

Teste mal die Varianten. Ich arbeite da lieber mit D-Klick als Selection.

Code:

'Variante 1 Doppelklick im Kalender -> alle Tage die ="D6" und rechts vom Klick sind Färben

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngKalender As Range, rngDatum As Range, zelle

Set rngDatum = Range("F6:NG6")
Set rngKalender = Range("F8:NG57")

If Not Intersect(Target, rngKalender) Is Nothing Then
rngKalender.Interior.Color = RGB(193, 252, 255)

Set rngDatum = Range(Cells(rngDatum.Row, Target.Column), Cells(rngDatum.Row, Target.Column).End(xlToRight))
'MsgBox rngDatum.Address

For Each zelle In rngDatum
   If Day(zelle.Value) = Range("D6").Value Then Cells(Target.Row, zelle.Column).Interior.Color = RGB(192, 0, 0)
Next zelle

   Cancel = True
End If

Set rngDatum = Nothing
Set rngKalender = Nothing

End Sub

'********************************************************************************************************



''Variante 2 Doppelklick im Kalender -> alle Tage die ="D6" und rechts vom Klick noch Anzeigen
'
'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Dim rngKalender As Range, rngDatum As Range, zelle
'
'Set rngDatum = Range("F6:NG6")
'Set rngKalender = Range("F8:NG57")
'
'If Not Intersect(Target, rngKalender) Is Nothing Then  'Doppel Klick im Kalender
'   rngKalender.EntireColumn.Hidden = False
'   Set rngDatum = Range(Cells(rngDatum.Row, Target.Column), Cells(rngDatum.Row, Target.Column).End(xlToRight))
'   'MsgBox rngDatum.Address
'   rngDatum.EntireColumn.Hidden = True
'
'   For Each zelle In rngDatum
'     If Day(zelle.Value) = Range("D6").Value Then Cells(Target.Row, zelle.Column).EntireColumn.Hidden = False
'   Next zelle
'
'   Cancel = True
'Else       'Doppel Klick ausserhalb Kalender
'   rngKalender.EntireColumn.Hidden = False
'   Cancel = True
'End If
'
'Set rngDatum = Nothing
'Set rngKalender = Nothing
'
'End Sub

Gruß Elex

[Sagulum]

Hallo Elex, hallo Stephan

Danke, dass ihr euch mit meinem Problem auseinandergesetzt habt. Eure Lösungen sind nicht ganz das, was ich wollte, habs wohl nicht genau genug beschrieben was ich erreichen will.
Ich möchte mir erst mal selber was aus eurem Code zusammenbasteln, den ihr erstellt habt. Denn mein Problem lag immer darin, die Tage, die markiert werden sollen zu finden. Ich werde mich auf jeden Fall noch einmal melden. Entweder um meine Lösung zu zeigen oder um euch noch einmal um Hilfe zu bitten.

Erst mal vielen vielen Dank, das Sagulum

[Sagulum]

Hallo Elex, Hallo Stephan

Es läuft, juhu. Siehe im Code die Zeile die mit 'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO endet.

Noch einmal vielen Dank.