Anzeige
Archiv - Navigation
1552to1556
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

bedingte Formatierung zu langasam in VBA

bedingte Formatierung zu langasam in VBA
18.04.2017 13:36:31
Andi
Hallo,
importiere jeden Tag Daten aus einer anderen Excel Datei und in der aktuellen Tabelle habe ich bedingte formatierung für Spalten, die aber mit desen VBA Code zu langsam (bis zu 10000 Zeilen) sind,
kann man das beschleunigen oder kürzer schreiben.
Danke im vorraus!!
Sub bedFormatierung()
Dim i As Long
Dim letzte As Long
Dim StatusCalc As Long
'With Application
'    .ScreenUpdating = False
'    StatusCalc = .Calculation
'    .Calculation = xlCalculationManual
'End With
letzte = tabArtikel.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To letzte
Select Case Cells(i, 5).Value
Case Is > 1
With Cells(i, 5)
.Font.Bold = True
.Font.ColorIndex = 3 'rot
End With
Case Is  1
With Cells(i, 6)
.Font.Bold = True
.Font.ColorIndex = 3 'rot
End With
Case Is  1
With Cells(i, 7)
.Font.Bold = True
.Font.ColorIndex = 3 'rot
End With
Case Is  30
With Cells(i, 8)
.Font.Bold = True
.Font.ColorIndex = 3 'rot
End With
Case Is  35
With Cells(i, 9)
.Font.Bold = True
.Font.ColorIndex = 3 'rot
End With
Case Is  35
With Cells(i, 10)
.Font.Bold = True
.Font.ColorIndex = 3 'rot
End With
Case Is  30
With Cells(i, 11)
.Font.Bold = True
.Font.ColorIndex = 3 'rot
End With
Case Is  10
With Cells(i, 12)
.Font.Bold = True
.Font.ColorIndex = 3 'rot
End With
Case Is  10
With Cells(i, 13)
.Font.Bold = True
.Font.ColorIndex = 3 'rot
End With
Case Is > 10
With Cells(i, 13)
.Font.Bold = False
.Font.ColorIndex = xlColorIndexAutomatic
End With
End Select
Select Case Cells(i, 14).Value
Case Not 950 To 1030
With Cells(i, 14)
.Font.Bold = False
.Font.ColorIndex = xlColorIndexAutomatic
End With
Case Is  1030
With Cells(i, 14)
.Font.Bold = True
.Font.ColorIndex = 3 'rot
End With
End Select
Select Case Cells(i, 15).Value
Case Is > 2
With Cells(i, 15)
.Font.Bold = True
.Font.ColorIndex = 3 'rot
End With
Case Is  9
With Cells(i, 16)
.Font.Bold = True
.Font.ColorIndex = 3 'rot
End With
End Select
Next i
'With Application
'    .ScreenUpdating = True
'    .Calculation = StatusCalc
'End With
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
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

Anzeige
AW: Vielen Dank Franz
19.04.2017 08:35:36
Andi
Hallo Franz,
vielen Dank für deine Hilfe,hat super geklappt
Gruß Andi
AW: bedingte Formatierung zu langasam in VBA
18.04.2017 16:22:31
ChrisL
Hi Andi
Hier noch ein Ansatz mit Autofilter:

Sub test()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Call MachFarbig(5, ">1")
Call MachFarbig(6, ">1")
Call MachFarbig(7, ">1")
Call MachFarbig(8, ">30")
Application.Calculation = xlCalculationAutomatic
End Sub

Private Sub MachFarbig(intSpalte As Integer, strKriterium As String)
Dim letzte As Long
With tabArtikel
letzte = .Cells(Rows.Count, 1).End(xlUp).Row
With .Columns(intSpalte).Font
.Bold = False
.ColorIndex = xlColorIndexAutomatic
End With
.Rows(1).AutoFilter
.UsedRange.AutoFilter Field:=intSpalte, Criteria1:=strKriterium
With .Columns(intSpalte).Font
.Bold = True
.ColorIndex = 3
End With
.Rows(1).AutoFilter
End With
End Sub

cu
Chris
Anzeige

320 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige