Bedingte Formatierung in Schleife

Sub fixafarger3() Dim colorArea As Range Dim villkorArea As Range Dim areaAll As Range Dim Counter As Integer Set colorArea = Blad1.Range("C8:J11") ', C16:J19, C22:J26") Set areaAll = Blad1.Range("C7:J26") areaAll.FormatConditions.Delete For Counter = 1 To 30 colorArea.FormatConditions.Add Type:=xlExpression, Formula1:="=OM(C$8=data!$A$" & _ Counter & ";SANT;"""")" 'SANT bedeutet WAHR colorArea.FormatConditions(1).Interior.Color = Data.Cells(Counter, 2).Interior. _ Color Next Counter End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub fixafarger3() Dim colorArea As Range Dim villkorArea As Range Dim areaAll As Range Dim Counter As Integer Dim Last As Long Dim ws As Worksheet Last = Worksheets("Data").Cells(1048576, 1).End(xlUp).Row For Each ws In ThisWorkbook.Worksheets If Not ws.Name = "Data" Then Set areaAll = ws.Range("C7:J26") areaAll.FormatConditions.Delete Set colorArea = ws.Range("C8:J11") For Counter = 3 To Last colorArea.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=Data. _ Cells(Counter, 1) colorArea.FormatConditions(Counter - 2).Interior.Color = Data.Cells(Counter, 2). _ Interior.Color Next Counter Counter = 1 End If Next End Sub

Hallo Basti!
Vielen Dank für die Hilfe.
Ich habe das Makro nun noch etwas ausgebaut (noch ne Schleife reingemacht, weil die Farben in mehreren Blöcken angezeigt werden müssen) aber das Makro stürzt ab **wenn es auf das nächste worksheet geht.**
Die Original Datei hat übrigens 31 worksheets, nicht nur 3 wie in der Beispiel Datei unten.
In dieser Zeile:
Set colorArea = ws.Range(Cells(ProductRow, 3), Cells(ProductRow + 3, 10))
Die Formel für die Farben muss übrigens so sein wie ich sie eingegeben habe (es sollen mehrere Zellen farbig werden, nicht nur die in der das Wort steht)

Sub fixafarger5()
Dim colorArea As Range
Dim villkorArea As Range
Dim areaAll As Range
Dim Counter As Integer
Dim Last As Long
Dim ws As Worksheet
Dim ProductRowCounter As Long
Dim ProductRow As Integer
Last = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Data" Then
ws.Unprotect
Set areaAll = ws.Range("C7:J26")
areaAll.FormatConditions.Delete
ProductRow = 8
ProductRowCounter = 1
For ProductRowCounter = 1 To 3
Set colorArea = ws.Range(Cells(ProductRow, 3), Cells(ProductRow + 3, 10))
For Counter = 3 To Last
colorArea.FormatConditions.Add Type:=xlExpression, Formula1:="=OM(C$" &  _
ProductRow & "=data!$A$" & Counter & ";SANT;"""")"
colorArea.FormatConditions(Counter - 2).Interior.Color = Data.Cells( _
Counter, 2).Interior.Color
Next Counter
Counter = 1
ProductRow = ProductRow + 6
Next ProductRowCounter
End If
ws.Protect
Next ws
End Sub

Hier die neue Beispiel Datei:

Die Datei https://www.herber.de/bbs/user/107842.xlsm wurde aus Datenschutzgründen gelöscht

Hast du ne Idee warum das nicht weiterläuft?
Viele Grüsse
Daniel

Beliebteste Forumthreads (12 Monate)

Bedingte Formatierung in Schleife

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bedingte Formatierung in Schleife

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread