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
Hi
Kann man machen. Wäre es aber nicht übersichtlicher nur diese Tage(Spalten) einzublenden und die anderen dann aus.
Gruß Elex
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.
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
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
Hallo Elex, Hallo Stephan
Es läuft, juhu. Siehe im Code die Zeile die mit 'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO endet.
Noch einmal vielen Dank.
