Bombenlegerformel - bed. Formatierung
25.11.2005 09:10:49
Horst
fand ein kurzes script, müßte aber meine Formatierung darin eingebunden haben. Meine Versuche schlugen fehl. Textspalte F hat 3 Begriffe, die jeweils Rot, Blau und Schwarz für die gesamte Tabelle steuern. Bereich 1 (B:M) soll nur schriftfarblich aufgrund F; Bereich 2 (O:GT) sind durch Eingabe von X oder R Hintergrund und Schriftfarbe sofort aufgrund Spalte F zu ändern und Bereich 3 (GV:HC) wie Bereich 1. Wer kann mir das mit einbinden? Wäre sehr dankbar!!
gefunden und schön kurz:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ber As Range
Set ber = Intersect(Target, Range("B6:AF20"))
If Not ber Is Nothing Then
With ber.Interior
Select Case ber(1).Value
Case 1
.ColorIndex = 1
Case 2
.ColorIndex = 2
Case 3
.ColorIndex = 3
Case 4
.ColorIndex = 4
Case 5
.ColorIndex = 5
Case 6
.ColorIndex = 6
Case Else
.ColorIndex = xlColorIndexNone
End Select
End With
End If
End Sub
meine Makroaufzeichnung (Formatierung einbinden):
Sub bedingt_Format2()
' Textzeilen bedingte Formatierung Rot, Blau, Schwarz
Application.Goto Reference:="Format2"
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$F5=""2x/Woche"""
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$F5=""1x/Woche"""
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$F5=""1x/Monat"""
With Selection.FormatConditions(3).Font
.Bold = True
.Italic = False
.ColorIndex = 1
End With
Selection.Copy
ActiveWindow.LargeScroll Down:=15
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("D5").Select
End Sub
Sub bedingt_Format1()
Application.Goto Reference:="Format1"
'Austausch X zu R
' ActiveWorkbook.Save
Selection.Replace What:="X", Replacement:="R", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
' bedingtes Format Rot, Blau, Schwarz
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=UND($F5=""2x/Woche"";ODER(O5=""R"";O5=""X""))"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=UND($F5=""1x/Woche"";ODER(O5=""R"";O5=""X""))"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
Selection.FormatConditions(2).Interior.ColorIndex = 5
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=UND($F5=""1x/Monat"";ODER(O5=""R"";O5=""X""))"
With Selection.FormatConditions(3).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
Selection.FormatConditions(3).Interior.ColorIndex = 1
Range("d5").Select
End Sub
Sub bedingt_Format3()
Application.Goto Reference:="Format3"
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$F5=""2x/Woche"""
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$F5=""1x/Woche"""
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$F5=""1x/Monat"""
With Selection.FormatConditions(3).Font
.Bold = True
.Italic = False
.ColorIndex = 1
End With
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("GV:HC").Select
Selection.ColumnWidth = 8
Range("d5").Select
End Sub