aktualisieren beim Start der Mappe

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim D As Date D = [C1] 'Wenn mehr als eine Zelle markiert wurde dann Makro beenden If Target.Cells.Count > 1 Then Exit Sub Select Case Target.Value 'bei Leer, keine Hintergrundfarbe Case Empty Target.Interior.ColorIndex = 0 'bei kleiner als Hintergrundfarbe rot Case Is D Target.Interior.ColorIndex = 4 'bei gleich Hintergrundfarbe gelb Case Is = D Target.Interior.ColorIndex = 6 End Select End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Thomas,
warum Makro-Lösung, wenn es mit bedingter Formatierung auch geht?
In der Makrolösung muss du die Prozeduren etwas aufteilen.
Die von mir an der Formatierungs-Prozedur gemachte Änderung passt auch Änderungen in mehreren Zellen der Spalte 2 an.
Gruß
Franz

 'Code unter DieseArbeitsmappe
Private Sub Workbook_Open()
With Worksheets("Tabelle1")
Call Formatieren(Bereich:=.Range(.Cells(2, 2), .Cells(.Rows.Count, 2)), Datum:=.Range("C1")) _
End With
End Sub
'Code  im Tabellenblatt-Modul
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Prüfung des geänderten Zellbereichs
If Target.Row > 1 And Target.Column = 2 And Target.Columns.Count = 1 Then
Call Formatieren(Bereich:=Target, Datum:=[C1])
End If
End Sub
'Code in einem allgemeinen Modul
Public Sub Formatieren(Bereich As Range, Datum As Date)
Dim Zelle As Range
'Wenn mehr als eine Zelle markiert wurde dann Makro beenden
For Each Zelle In Bereich
Select Case Zelle.Value
'bei Leer, keine Hintergrundfarbe
Case Empty
Zelle.Interior.ColorIndex = 0
'bei kleiner als Hintergrundfarbe rot
Case Is  Datum
Zelle.Interior.ColorIndex = 4
'bei gleich Hintergrundfarbe gelb
Case Is = Datum
Zelle.Interior.ColorIndex = 6
End Select
Next Zelle
End Sub

'Code unter DieseArbeitsmappe Private Sub Workbook_Open() With Worksheets("Tabelle1") Call Formatieren(Bereich:=.Range("E5:AC149"), Datum:=.Range("C1")) End With End Sub 'Code Tabellenblatt-Modul Private Sub Worksheet_Change(ByVal Target As Excel.Range) 'Prüfung des geänderten Zellbereichs If Not Intersect(Target, Range("E5:AC149")) Is Nothing Then Call Formatieren(Bereich:=Intersect(Target, Range("E5:AC149")), Datum:=[C1]) End If End Sub

Public Sub Formatieren(Bereich As Range, Datum As Date) 'Datum in den Zellen des Bereiches mit dem Vorgabe-Datum vergleichen und Zellen formatieren 'Datum in früherem Monat als Vorgabe-Datum --> Hintergrundfarbe rot 'Datum in gleichem Monat wie Vorgabe-Datum --> Hintergrundfarbe gelb 'Datum in späterem Monat als Vorgabe-Datum --> Hintergrundfarbe grün Dim Zelle As Range, Datum1 As Date, Datum2 As Date For Each Zelle In Bereich If IsEmpty(Zelle) Then Zelle.Interior.ColorIndex = 0 ElseIf IsDate(Zelle) Then Datum1 = DateSerial(Year(Datum), Month(Datum), 1) Datum2 = DateSerial(Year(Zelle.Value), Month(Zelle.Value), 1) If Datum2 Datum1 Then Zelle.Interior.ColorIndex = 4 If Datum2 = Datum1 Then Zelle.Interior.ColorIndex = 6 End If Next Zelle End Sub

Beliebteste Forumthreads (12 Monate)

aktualisieren beim Start der Mappe

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread