Projektplan Autoformat - Hilfe benötigt!
10.12.2008 09:26:35
Nils
ich habe hier ein etwas komplexeres Problem, welches ich nicht mehr gelöst bekomme.
Unten findet Ihr die Funktion, die im Moment dafür sorgt, dass bestimmte Datumsfelder für einen Projektplan entsprechend befüllt und eingefärbt werden. (sozusagen als Übersichtsplan nach Datum, wann was zu tun ist)
Bisher war diese Ablauf (also was wann wie viele Tage nach Starttermin stattfindest) immer gleich und daher mit der unten stehenden Funktion erfassbar. Jetzt allerdings gibt es je nach Art des Jobs 3 mögliche Timings.
Ergo ich müsste wenn in dem Tabellenblatt "Liste_Jobs" die Spalte AC AD oder AE ein "x" (gibt dann an, welches Timing zum tragen kommt) hat den entsprechenden Projektverlauf in den Kalender eintragen.
Eigentlich müsste ich so was wie ein IF THEN ELSE Bedingung um meine komplette Funktion basteln, die eben die oben genannten Felder prüft. Geht das?
Wer kann mit helfen?
Danke schon mal im Voraus, Nils.
P.S.:
Zu den beiden unten aufgeführten gibts noch eine Funktion, die prüft, ob das Startdatum in der Tabelle "Liste_Jobs" verändert wurde und die dann die Sub Autoformat aufruft.
Private objWks As Worksheet, lngSpalte As Long, SpalteLast As Long
Private Const Farbe0 As Long = 3 'Rot -Farbe 1. Arbeitstag ab Startdatum
Private Const Farbe1 As Long = 4 'grün -Farbe 2. Arbeitstag ab Startdatum
Private Const Farbe2 As Long = 6 'gelbe -Farbe 3. Arbeitstag ab Startdatum
Private Const Farbe3 As Long = 5 'blau -Farbe 4. Arbeitstag ab Startdatum
Private Const FarbeN As Long = 2 'hellbeige -Farbe restliche Tage im Kalender
Private Const strMark As String = "o" 'optionaler Markierungstext in Zellen
Sub Autoformat(wks As Worksheet, Startvar As Date, _
Zeile As Long, zeileDatum As Long, spalteDatum1 As Long)
Dim Zelle As Range, AktDatevar As Date, Spalte As Long, bolGefunden As Boolean
'wks = Tabellenblatt in dem Formatierung ausgeführt werden soll
'Startvar = Startdatum der Aktivität
'Zeile = Zeile in der Startdatum geändert wurde
'zeileDatum = Zeile mit den Datumswerten
'spalteDatum1 = Spalte mit 1. Datum in Zeile "zeileDatum"
Set objWks = wks
With wks
'Spalte mit Start-Datum suchen
SpalteLast = IIf(IsEmpty(.Cells(zeileDatum, .Columns.Count)), _
.Cells(zeileDatum, .Columns.Count).End(xlToLeft).Column, .Columns.Count)
For Spalte = spalteDatum1 To SpalteLast
'Vergleichsdatum einlesen
AktDatevar = .Cells(zeileDatum, Spalte).Value
If Startvar = AktDatevar Then
lngSpalte = Spalte
bolGefunden = True: Exit For
Else
'Zelle formatieren, leeren
With .Cells(Zeile, Spalte)
.Interior.ColorIndex = FarbeN
.ClearContents
End With
End If
Next
If bolGefunden = True Then
'Tage ab Starttag markieren, Wochenende und Feiertage werden dabei übersprungen
'Starttag markieren
Call nextWorkday(Zeile, zeileDatum, Farbe0, strMark)
If lngSpalte = SpalteLast Then Exit Sub
'1. Tag nach Starttag markieren
lngSpalte = lngSpalte + 1
Call nextWorkday(Zeile, zeileDatum, Farbe1, strMark)
If lngSpalte = SpalteLast Then Exit Sub
'2. Tag nach Starttag markieren
lngSpalte = lngSpalte + 1
Call nextWorkday(Zeile, zeileDatum, Farbe2, strMark)
If lngSpalte = SpalteLast Then Exit Sub
'3. Tag Starttag markieren
lngSpalte = lngSpalte + 1
Call nextWorkday(Zeile, zeileDatum, Farbe3, strMark)
If lngSpalte = SpalteLast Then Exit Sub
'Restliche Spalten markieren
lngSpalte = lngSpalte + 1
If lngSpalte With .Range(.Cells(Zeile, lngSpalte), .Cells(Zeile, SpalteLast))
.Interior.ColorIndex = FarbeN
.ClearContents
End With
End If
Else
MsgBox "Startdatum " & Startvar & " nicht gefunden!"
End If
End With
End Sub
Private Function nextWorkday(lngZeile, lngZeileDatum As Long, Farbe As Long, _
Optional strText As String) As Long
Dim Datum As Date, rngFeier As Range, bolFeiertag As Boolean
'Zellenbereich mit den Datumsangaben zu den Feiertagen
Set rngFeier = Worksheets("Feiertage").Range("Feiertage")
With objWks
Datum = .Cells(lngZeileDatum, lngSpalte)
If Not rngFeier.Find(what:=Datum, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then _
bolFeiertag = True
'Feiertage und Wochenden überspringen
Do Until Not (WeekDay(Datum) = vbSaturday Or WeekDay(Datum) = vbSunday Or bolFeiertag = _
True)
With .Cells(lngZeile, lngSpalte)
.Interior.ColorIndex = FarbeN
.ClearContents
End With
lngSpalte = lngSpalte + 1
nextWorkday = lngSpalte
If lngSpalte = SpalteLast Then
MsgBox "Konnte nicht markieren, da Ende von Kalenderbereich erereicht!"
Exit Function
End If
Datum = .Cells(lngZeileDatum, lngSpalte).Value
If Not rngFeier.Find(what:=Datum, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
bolFeiertag = True
Else
bolFeiertag = False
End If
Loop
'Zelle formatieren und Markierung eintragen
With .Cells(lngZeile, lngSpalte)
.Interior.ColorIndex = Farbe
If strText "" Then
.Value = strMark
Else
.ClearContents
End If
End With
End With
End Function