Hilfe bei Erstellung eines Makros

Question

Hallo miteinander,

ich versuche ein Makro zuerstellen, dass auch die Daten nach dem aktuellen Datum farblich kennzeichnen soll.

So wie es jetzt dargestellt ist werden alle Daten des lfd. Monats gekennzeichnet.

Hat jemand eine Idee ob das geht und wenn ja - Wie ?

MfG Odje

Option Explicit

Sub Test()

Dim Datum As Date
Dim Zeile As Long

Zeile = 1

Do Until IsEmpty(Cells(Zeile, 2))

Datum = Cells(Zeile, 2)

With Range(Cells(Zeile, 1), Cells(Zeile, 2))
.Interior.ColorIndex = xlNone

'diese IF-Anweisung soll nur die Daten die nach dem aktuellen Datum liegen farblich markieren
If Month(Day(Datum) & "." & Month(Datum) & "." & Year(Datum)) = Month(Now) Then
.Interior.ColorIndex = 19
End If

If CDate(Day(Datum) & "." & Month(Datum) & "." & Year(Datum)) = Date Then
.Interior.ColorIndex = 35
End If

End With

Zeile = Zeile + 1
Loop

End Sub

Answer 1

Hallo,

ist nicht ganz verständlich was das sool

With Range(Cells(Zeile, 1), Cells(Zeile, 2))
.Interior.ColorIndex = xlNone

'diese IF-Anweisung soll nur die Daten die nach dem aktuellen Datum liegen farblich markieren
If Month(Day(Datum) & "." & Month(Datum) & "." & Year(Datum)) = Month(Now) Then
.Interior.ColorIndex = 19
End If

If CDate(Day(Datum) & "." & Month(Datum) & "." & Year(Datum)) = Date Then
.Interior.ColorIndex = 35
End If

End With

Zudem ist für Daten die nach (also größer sind) liegen dieses > zu verwenden. Aus meiner Sicht

With Range(Cells(Zeile, 1), Cells(Zeile, 2))
.Interior.ColorIndex = xlNone

If Month(Datum) => Month(Now) Then
.Interior.ColorIndex = 19
End If

If CDate(Day(Datum) & "." & Month(Datum) & "." & Year(Datum)) => Date() Then
.Interior.ColorIndex = 35
End If

End With

Wobei ich CDate() als funktion nicht kenne

Gruß

Helmut

Answer 2

Hallo Helmuth

die CDATE()-Umwandlungsfunktionen wandelt einen Text in ein Datumsformat um.

Weitere Hilfe kann ich nicht geben, da ich die Aufgabenstellung (noch) nicht verstanden habe.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 3

Hallo zusammen,

dieses Makro soll seine Dienste erweisen indem es anzeigt wann neue Medikamente bestellt werden müssen,
so waren meine Vorstellungen :
1. das aktuelle Bestelldatum wird markiert
2. alle Daten nach dem Bestelldatum sollen auch markiert werden
um zu prüfen, ob in den nächsten 10 Tagen noch weite Medikamente bestellt werden müssten.

Hier meine Datei:
www.file-upload.net/download-1915026/Test_Bestelldatum_ermitteln.xls.html

Answer 4

Hallo nok106,

ich weiß jetzt nicht, ob ich Dich richtig verstanden habe, aber versuche es mal mit folgendem VBA-Code.

Kopiere das Makro in das VBA-Projekt "DieseArbeitsmappe" und tausche es gegen Dein vorhandenen VBA-Code aus.
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Sub Workbook_Open()

Dim Datum As Date
Dim Zeile As Long
Dim Namen As String

Zeile = 2

Do Until IsEmpty(Cells(Zeile, 6))

Datum = Cells(Zeile, 6)

With Range(Cells(Zeile, 1), Cells(Zeile, 6))
.Interior.ColorIndex = xlNone
If Month(Day(Datum) & "." & Month(Datum) & "." & Year(Datum)) >= Month(Now) Then
.Interior.ColorIndex = 19
If CDate(Day(Datum) & "." & Month(Datum) & "." & Year(Date)) >= Date Then
.Interior.ColorIndex = 35
Namen = Namen & Cells(Zeile, 1) & vbLf
End If
End If
End With

Zeile = Zeile + 1
Loop

If Namen <> "" Then
MsgBox Namen, vbInformation, "Medikamente bestellen:"
Else
MsgBox "", vbExclamation, "Es liegen keine Bestell-Daten vor!"
End If
End Sub

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 5

Hallo,

mir ist immer noch nicht klar, warum du erst das Datum in Tag Monat und Jahr zerlegst um es direkt wieder zusammenzusetzen.

Sonst ist die Lösung von @coros ok und entspricht den Angaben aus meiner AW 1.

Gruß

Helmut

Answer 6

Hallo zusammen,

sorry, ich bin ein Anfänger in Sachen VBA.

Genügen würde wenn das Makro so umgebaut wird das nach dem aktuellen Datum noch 10 Tage dazu gerechnet werden.

Ist das machbar?

Hab vielen Dank für eure Mühe!

Viele Grüße und schönen Abend

Odje

Answer 7

Hallo Odje,

tausche Deine Code gegen den ancfolgenden aus.

Option Explicit

Private Sub Workbook_Open()

Dim Datum As Date
Dim Zeile As Long
Dim Namen As String

Zeile = 2

Do Until IsEmpty(Cells(Zeile, 6))

Datum = Cells(Zeile, 6)

With Range(Cells(Zeile, 1), Cells(Zeile, 6))
.Interior.ColorIndex = xlNone
If Month(Day(Datum) & "." & Month(Datum) & "." & Year(Datum)) >= Month(Now) Then
.Interior.ColorIndex = 19
If CDate(Day(Datum) & "." & Month(Datum) & "." & Year(Date)) >= Date And _
CDate(Day(Datum) & "." & Month(Datum) & "." & Year(Date)) < Date + 10 Then
.Interior.ColorIndex = 35
Namen = Namen & Cells(Zeile, 1) & vbLf
End If
End If
End With

Zeile = Zeile + 1
Loop

If Namen <> "" Then
MsgBox Namen, vbInformation, "Medikamente bestellen:"
Else
MsgBox "", vbExclamation, "Es liegen keine Bestell-Daten vor!"
End If
End SubIch hoffe, Du meintest das so?

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 8

Hallo Oliver,

Genau so hab ich’s mir vorgestellt.

Habe noch etwas geändert, (If Month.......... ) habe ich rausgenommen.

Odje

Answer 9

Hallo Odje,

gerne geschehen. Danke auch für die Rückmeldung.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]