Datum in einem "Zeitstrahl" farbig hervorheben

Dominik · 2015-02-11T08:39:49+00:00

Guten Morgen liebe Makroprofis :-), seit einigen Tagen versuche ich mit meinen beschränkten Makrokenntnissen einen vorgegebenen Datumsbereich in einem "Zeitstrahl" farbig zu makieren. Hierbei gibt es die Spalten E und F. In E wird das Startdatum eingetragen und in F das Enddatum. In Spalte C wird die Farbe durch die gewälte Baugruppe vorgegeben. Nun wäre es toll, wenn nach Eintragen des Datums von Start und Ende im Zeitstrahl der Bereich in der "Baugruppenfarbe" angegeben wird. Leider sind meine Kenntnisse bei weitem nicht ausreichend um so etwas zu realisieren :-(. Vielleicht hat jemand von euch die Zeit und die Muse um mir zu helfen :-) Danke im Voraus für eure Mühe! Die Datei habe ich angehängt. https://www.herber.de/bbs/user/95674.xlsm

Hi vielleicht diese MAkros?

Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.Worksheets("Übersicht").Unprotect Password:="porsche"
If Not Intersect(Target, Range("C8:C1000")) Is Nothing And Target.Count = 1 Then
Target.Offset(, -1) = Date
ThisWorkbook.Worksheets("Übersicht").Protect Password:="porsche"
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column  6 Then
Application.EnableEvents = True
Exit Sub
End If
ThisWorkbook.Worksheets("Übersicht").Unprotect Password:="porsche"
Dim sh As Worksheet
Set sh = Sheets("Übersicht")
Dim c As Integer
Application.EnableEvents = False
Select Case sh.Cells(Target.Row, 3)
Case Is = "Fahrzeug"
c = 10
Case Is = "Motor"
c = 44
Case Is = "Getriebe"
c = 33
End Select
sh.Range("G" & Target.Row & ":IV" & Target.Row).Select
Selection.FormatConditions.Delete
sh.Cells(Target.Row, 7).Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=UND(G$6>=$E$" & _
Target.Row & ";G$6

Gruß
Jochen

Ich habe hier momentan nur Office 2003,
Daher muss der Bereich überall wo "IV" steht noch angepasst wwerden!!!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column  6 Then
Application.EnableEvents = True
Exit Sub
End If
ThisWorkbook.Worksheets("Übersicht").Unprotect Password:="porsche"
Dim sh As Worksheet
Set sh = Sheets("Übersicht")
Dim c As Integer
Application.EnableEvents = False
Select Case sh.Cells(Target.Row, 3)
Case Is = "Fahrzeug"
c = 10
Case Is = "Motor"
c = 44
Case Is = "Getriebe"
c = 33
End Select
sh.Range("G" & Target.Row & ":IV" & Target.Row).Select
Selection.FormatConditions.Delete
sh.Cells(Target.Row, 7).Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=UND(G$6>=$E$" & _
Target.Row & ";G$6=6"
Selection.FormatConditions(2).Interior.ColorIndex = 35
Selection.Copy
sh.Range("H" & Target.Row & ":IV" & Target.Row).Select
Selection.PasteSpecial _
Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
sh.Range(Target.Address).Select
Application.EnableEvents = True
ThisWorkbook.Worksheets("Übersicht").Protect Password:="porsche"
End Sub

Datum in einem "Zeitstrahl" farbig hervorheben

Forumthread: Datum in einem "Zeitstrahl" farbig hervorheben

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial