Makro braucht 40 min.

22/05/2009 - 23:46 von Willi Emmrich | Report spam
Hi NG,
mein Makro braucht circa 40 min.
Làsst sich das Beschleunigungen.

Sub Bed_Format()
Application.ScreenUpdating = False
Rows("2:2").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Range("I2").Select
For i = 2 To 9610 'Ende des Datenbereiches
Cells(i, 9).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-5]>RC[-3],""mindest Bestand unterschritten"","""")"
Range(Cells(i, 1), Cells(i, 9)).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, _
Formula1:="=$D" & i & ">$F" & i & ""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
Next i
Application.ScreenUpdating = True
End Sub
 

Lesen sie die antworten

#1 Hajo
23/05/2009 - 08:07 | Warnen spam
Hallo Willi,

Option Explicit

Sub Bed_Format()
Application.ScreenUpdating = False
' warum muss in diesem Makro Fixiert werden ?????
Rows("2:2").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
For i = 2 To 9610 'Ende des Datenbereiches
Cells(i, 9).FormulaR1C1 = _
"=IF(RC[-5]>RC[-3],""mindest Bestand unterschritten"","""")"
With Range(Cells(i, 1), Cells(i, 9))
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=$D" & i & ">$F" & i & ""

.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = True
End With
Next i
Application.ScreenUpdating = True
End Sub


Gruß Hajo
MVP für Microsoft Excel
Betriebssystem Vista Ultimate SP1 und Excel Version2007 SP1
http://Hajo-Excel.de/


"Willi Emmrich" wrote:

Hi NG,
mein Makro braucht circa 40 min.
Làsst sich das Beschleunigungen.

Sub Bed_Format()
Application.ScreenUpdating = False
Rows("2:2").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Range("I2").Select
For i = 2 To 9610 'Ende des Datenbereiches
Cells(i, 9).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-5]>RC[-3],""mindest Bestand unterschritten"","""")"
Range(Cells(i, 1), Cells(i, 9)).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, _
Formula1:="=$D" & i & ">$F" & i & ""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
Next i
Application.ScreenUpdating = True
End Sub



Ähnliche fragen