Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1028to1032
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Projektplan Autoformat - Hilfe benötigt!

Projektplan Autoformat - Hilfe benötigt!
10.12.2008 09:26:35
Nils
Hallo,
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


1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Ergänzung...
10.12.2008 09:38:00
Nils
Alternativ könnte man auch die Abfrage so umschreiben,
dass diese je nach dem ob in Spalte AC AD oder AE ein Kreuz ist jeweils andere Sub Autoformat (also dann 1-3) aufgerufen werden.
Hier die Funktion, die das Datum prüft, die dann angepasst werden müsste:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle
Const SpalteDatum = 5 'Spalte E in der Startdatum überwacht werden soll
Const Zeile1 = 4 '1. zeile ab der Eingabedatum überwacht werden soll
'Prüfen ob Eingabezelle in Spalte "SpalteDatum" unterhalb von "Zeile1" geändert wurde
'Es können innerhalb der Spalte auch mehrere Zellen geändert werden.
If Not Intersect(Target, Range(Cells(Zeile1, SpalteDatum), Cells(Rows.Count, _
SpalteDatum))) Is Nothing Then
Application.EnableEvents = False
For Each Zelle In Target
If Zelle.Column = SpalteDatum Then
Call Autoformat(wks:=Worksheets("Kalender"), Startvar:=Zelle.Value, _
Zeile:=Zelle.Row, zeileDatum:=3, spalteDatum1:=5)
End If
Next
Application.EnableEvents = True
End If
End Sub


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige