AW: bedingte Formatierung zu langasam in VBA
18.04.2017 16:01:03
fcs
Hallo Andi,
dann solltest du echte bedingte Formatierungen verwenden.
ansonsten könntest du erst für alle Spalten von E bis P die Formatierung auf nicht Fett und Farbe auf automatisch setzen.
Dann kannst du diesen Teil in den For-Next-Schleifen weglassen.
Die Bildschirm-Aktualisierung musst du auf jeden Fall vorrübergehend deaktivieren, um das Makro zu beschleunigen.
Gruß
Franz
Sub Bedingt_Formatieren()
' Bedingt_Formatieren Makro
Dim letzte As Long
Dim StatusCalc As Long
Dim rngRange As Range
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
With tabArtikel
.Select
letzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells.FormatConditions.Delete
Set rngRange = .Range(.Cells(2, 5), .Cells(letzte, 7)) 'Spalten E:G
With rngRange
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=1"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=1"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = False
.Italic = False
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Set rngRange = .Range(.Cells(2, 8), .Cells(letzte, 8)) 'Spalten H:H
With rngRange
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=30"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=30"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = False
.Italic = False
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Set rngRange = .Range(.Cells(2, 9), .Cells(letzte, 10)) 'Spalten I:J
With rngRange
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=35"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=35"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = False
.Italic = False
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Set rngRange = .Range(.Cells(2, 11), .Cells(letzte, 11)) 'Spalten K:K
With rngRange
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=30"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=30"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = False
.Italic = False
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Set rngRange = .Range(.Cells(2, 12), .Cells(letzte, 13)) 'Spalten L:M
With rngRange
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=10"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=10"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = False
.Italic = False
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Set rngRange = .Range(.Cells(2, 14), .Cells(letzte, 14)) 'Spalten N
With rngRange
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=950", Formula2:="=1030"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = False
.Italic = False
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
Formula1:="=950", Formula2:="=1030"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Set rngRange = .Range(.Cells(2, 15), .Cells(letzte, 15)) 'Spalten O
With rngRange
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=2"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=2"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = False
.Italic = False
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Set rngRange = .Range(.Cells(2, 16), .Cells(letzte, 16)) 'Spalten P
With rngRange
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=7", Formula2:="=7"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = False
.Italic = False
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
Formula1:="=7", Formula2:="=9"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
End With
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub