hier zwei Makros. deletefc löscht alle FC in dem aktiven Arbeitsblatt. MAn kann heir auch nicht einschränken ob man nur bestimmte FC löschen will. Angedeutet mit den auskommentierten IF-Bedingungen
und setFC erzeugt eine FC im aktiven Blatt, Ich habe deine Fornel etwas eingekürzt. Und der Teil F3<>"""" kann eigentlich weg, da F3 immer FS/BE sein muß.
Sub setFC()
'erstellt bedingte Formatierung
Dim ws As Worksheet, strWs$
Set ws = ActiveSheet
Call deletefc(ws.Name) 'alle FC löschen
With ws.Range("A1:B10") 'Bereich für die FC
.FormatConditions.Add Type:=xlExpression, Formula1:="=UND(F3<>"""";F3=""FS/BE"";ODER(F6=""MI/BE""; F9=""MI/BE""; F12=""MI/BE"";F15=""MI/BE"";F18=""MI/BE""))"
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 255 'Farbe zuweisen
.TintAndShade = 0
End With
.StopIfTrue = False
End With
End With
End Sub
Function deletefc(wsName As String) ', strKrit As String)
'löscht alle bedingten Formatierung anhand von Kriterien.
Dim i As Long, objfc As FormatCondition
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.EnableEvents = False
With Worksheets(wsName).Cells
For i = .FormatConditions.Count To 1 Step -1
On Error Resume Next
Set objfc = .FormatConditions(i)
'If objfc.AppliesTo.Cells.Count = 1 Then
' If objfc.Formula1 Like ("*" & strKrit & "*") Then
objfc.Delete
' End If
On Error GoTo 0
Next
End With
Application.EnableEvents = True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Function
|