|
Hallo Leute,
Ich hoffe Ihr könnt mir helfen.. ;-) Ich komme leider nicht mehr weiter.
Ich bearbeite gerade unser serviceüberwachungs Plan und finde nicht die passende Lösung für mein Problem in VBA-Excel.
Kurz erklärt:
In Spalte DB:DB ist die Kalenderwoche eingetragen.
In Zelle DB2 wird die Aktuelle Kalenderwoche automatisch generiert (zb. 33 Aktuelle Woche).
Alles was kleiner ist als die Aktuelle Woche (zb.33) sollte farblich erscheinen.
Zugleich sollte ebenfalls die Spalte AD:AD (ServiceTicket Nummer) farblich erscheinen damit man gleich den Pendenten Auftrag erkennen kann.
Ich hoffe Ihr mir Helfen. Bitte
Zb. Farbe:
- 0 Woche Grün
- 1 Woche Gelb
- 2 Woche Orange
- 3 Woche Rot
Terminiert = Grün
Abgeschlossen = Weiss
Leere Zelle gleich nichts (weiss)
Spalte (AD:AD) Spalte (DB:DB)
Heute ist Kalenderwoche (33)
Service - Nummer Datum Service Anfrage
Service-Nr.'030620161144 Terminiert
Service-Nr.'070620161038 33
Service-Nr.'130620161316 Abgeschlossen
Service-Nr.'140620160741 Abgeschlossen
Service-Nr.'140620160855 27
Service-Nr.'020620160859 Terminiert
Service-Nr.'200620160816 33
Service-Nr.'200620161424 Terminiert
Service-Nr.'210620161028 Terminiert
Service-Nr.'210620161054 28
Service-Nr.'210620161608 Abgeschlossen
Service-Nr.'230620161358 Terminiert
Service-Nr.'240620161316 Terminiert
Service-Nr.'270620161028 Abgeschlossen
Service-Nr.'270520161543 32
usw.
Provisorische Lösung :-((
Private Sub DatumPrüfen()
ThisWorkbook.Worksheets("Offene_Objekte").Range("DB1").Value = KalenderwocheNachDin(Date)
Dim Cell As Range
For Each Cell In Range("DB2:DB50")
If Cell.Value <= ThisWorkbook.Worksheets("Offene_Objekte").Range("DB1").Value Then Cell.Interior.ColorIndex = 4
If Cell.Value <= ThisWorkbook.Worksheets("Offene_Objekte").Range("DB1").Value - 1 Then Cell.Interior.ColorIndex = 44
If Cell.Value <= ThisWorkbook.Worksheets("Offene_Objekte").Range("DB1").Value - 2 Then Cell.Interior.ColorIndex = 45
If Cell.Value <= ThisWorkbook.Worksheets("Offene_Objekte").Range("DB1").Value - 3 Then Cell.Interior.ColorIndex = 3
If Cell.Value = "" Then Cell.Interior.ColorIndex = 0
If Cell.Value = "Abgeschlossen" Then Cell.Interior.ColorIndex = 0
If Cell.Value = "Terminiert" Then Cell.Interior.ColorIndex = 0
Next
End Sub
Function KalenderwocheNachDin(dat As Date) As Integer
Dim a As Integer
a = Int((dat - DateSerial(Year(dat), 1, 1) + ((Weekday(DateSerial(Year(dat), 1, 1)) + 1) Mod 7) - 3) / 7) + 1
If a = 0 Then
a = KalenderwocheNachDin(DateSerial(Year(dat) - 1, 12, 31))
ElseIf a = 53 And (Weekday(DateSerial(Year(dat), 12, 31)) - 1) Mod 7 <= 3 Then
a = 1
End If
KalenderwocheNachDin = a
End Function
|