VBA-Code: Datumsbereich abfragen - Tag 1 bis 21 nach aktuellem Tagesdatum ....

Question

Hallo,

mich lässt soeben mal wieder mein logisches Denken im Stich ;-((

Teil des Originalcodes:
If CDate(Day(Target) & "." & Month(Target) & "." & Year(Date)) + 10 <
Date Or _
CDate(Day(Target) & "." & Month(Target) & "." & Year(Date)) >
Date Then
Range(Target, Target.Offset(0, -2)).Interior.ColorIndex =
xlNone


Ich möchte den Code so ändern, dass
- Datum nach dem aktuellen Datum: keine Füllfarbe ( kein Problem )
- Datum bis 21 Tage nach aktuellem Datum: Füllfarbe rot


Mein Problem ist, wie frage ich den Bereich ( Tag 1 bis 21 ) ab ??

Kann mir jemand auf die Sprünge helfen ??

Vielen Dank schonmal

Petra

Answer 1

Hallo Petra,

Ich möchte den Code so ändern, dass
- Datum nach dem aktuellen Datum: keine Füllfarbe ( kein Problem )
- Datum bis 21 Tage nach aktuellem Datum: Füllfarbe rot

...das verstehe ich nicht ganz.
Gib doch bitte mal die von-bis Daten an (ausgehend vom aktuellen Datum), die rot und weiß gefärbt werden sollen.

Gruß
Rainer

Answer 2

Hallo, guten Morgen,

OK - folgendes:
Es geht darum, dass ich eine Geburtstagsliste erstellen möchte

In der Tabelle befinden sich:
A = Name
B = Vorname
C = Geburtsdatum

Ich möchte nun die Zellen A - C mit einer Hintergrundfarbe füllen,
wenn folgende Bedingungen zutreffen:

1. Geburtsdatum ( C ) liegt vor dem aktuellen Datum, dann Füllfarbe
entfernen
2. Geburtsdatum ( C )liegt bis 21 Tage nach dem aktuellen
Datum, dann Füllfarbe rot
3. Geburtsdatum ( C ) heute, dann Füllfarbe grün

zu 2.
Das heißt, dass z. B. heute alle Personen markiert werden sollen,
die bis zum 25. April Geburtstag haben.

Und genau da liegt mein Problem, sage ich z. B. ... + 21 > Date ...
so passiert gar nichts


Der komplette Code sieht so aus:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 3 Then
' wenn Datum nach dem aktuellen Datum oder mehr als 10 Tage
vor dem aktuellen Datum, liegt Füllfarbe zurücksetzen
If CDate(Day(Target) & "." & Month(Target) & "." & Year(Date)) + 10
< Date Or _
CDate(Day(Target) & "." & Month(Target) & "." & Year(Date)) >
Date Then
Range(Target, Target.Offset(0, -2)).Interior.ColorIndex = xlNone
Else
If CDate(Day(Target) & "." & Month(Target) & "." & Year(Date)) =
Date Then
'bei Übereinstimmung mit dem aktuellen Datum Füllfarbe Grün
Range(Target, Target.Offset(0, -2)).Interior.ColorIndex = 4
End If
End If
End If
End Sub

Answer 3

Hallo Petra,

probier's mal so:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 3 Then Exit Sub
If Target < Date Then
Range("A" & Target.Row & ":B" & Target.Row).Interior.ColorIndex = xlNone
ElseIf Target >= Date + 1 And Target <= Date + 21 Then
Range("A" & Target.Row & ":B" & Target.Row).Interior.ColorIndex = 3
Else
Range("A" & Target.Row & ":B" & Target.Row).Interior.ColorIndex = xlNone
End If
End Sub

Gruß
Rainer

Answer 4

Hi Petra,

schau dir mal das Beispiel Geburtstag einfärben von meiner HP, Seite "Beispiele m. VBA" an - vielleicht kann sie dir als Anregung dienen.

Bis später,
Karin

Answer 5

hi all ^^^

ich denke das hier bedingte formatierung die erste wahl ist

gruss nighty

Answer 6

Hallo,

sorry, aber ich hatte bisher noch keine Zeit zu antworten ...

@rainberg:

ElseIf Target >= Date + 1 And Target <= Date + 21 Then

So funktioniert es, super ;-)))
vielen Dank

@Beverly:
Das muss ich mir über Ostern mal in Ruhe anschauen.
Ich müsste dann eigentlich nur die Farbwerte ändern, bzw. die zukünftigen Geburtstage farbig anzeigen lassen.

@nighty:
Ehrlich gesagt habe ich diese Möglichkeit noch gar nicht in Betracht gezogen.
Scheint aber auch nicht uninteressant zu sein.

Da ist Ostern doch gesichert ;-))


Vielen Dank und viele Grüße
Petra

Answer 7

Hallo Petra,

anbei ein Beispiel mit der Bedingten Formatierung.

Download

Gruß
Rainer

Answer 8

Hallo,

also - das mit der bedingten Formatierung ist wirklich nicht schlecht ...

Ich habe jetzt im Endeffekt eine Mischung aus VBA und bedingter Formatierung
gewählt.
Per VBA lese ich meine Daten aus einer txt-Datei ein, die Formatierung nehme
ich per bedingter Formatierung vor.

Bedingung 1 ( wenn Geburtstag heute )
=UND(TAG(HEUTE())=TAG($C10);MONAT(HEUTE())=MONAT($C10))

Bedingung 2 ( wenn Geburtstag innerhalb der nächsten 21 Tage ):
=UND(WENN(DATWERT(TAG($C10) & "." & MONAT($C10) & "." &
JAHR(HEUTE()))>=HEUTE()-21;1;2)=1;WENN(DATWERT(TAG($C10) & "." &
MONAT($C10) & "." & JAHR(HEUTE()))<=HEUTE()+21;1;2)=1)

Die Formel für die 2. Bedingung habe ich übrigens über Google gefunden ( auf
so etwas wäre ich nicht gekommen )


Ich musste übrigens die Formeln von rainberg aus Antwort 7 umstellen, da es
sich bei den Datumswerten meiner Tabelle um Geburtsdaten handel, also z. B.
13.08.1976 (und nicht das 2012).

Vielen Dank für die Anregungen und Hilfe.

Gruss - Petra

Answer 9

Hallo Petra,

geht auch so

Formel für Bedingung 1:

=DATUM(JAHR($C2);MONAT(HEUTE());TAG(HEUTE()))=$C2

Formel für Bedingung 2:

=($C2>DATUM(JAHR($C2);MONAT(HEUTE());TAG(HEUTE()))+1)*($C2<=DATUM(JAHR($C2);MONAT(HEUTE());TAG(HEUTE()))+21)

Gruß
Rainer

Answer 10

Hallo, guten Morgen,

die Formel für die Bedingung 2 ist zumindest deutlich besser nachvollziehbar ;-))


Vielen, vielen Dank ...


Gruss Petra