AW: nächste rote Zelle gehen
nighty
hi paula :))
kein prob :))
dann so
gruss nighty
Rem zellen suchen die durch bedingte formatierung rot gefaerbt sind
Public zeileFest As Long
Public spalteFest As Integer
Sub makro01()
Dim zeilen As Long
Dim spalten As Integer
Dim zeilenLauf As Long
Dim spaltenLauf As Integer
Dim zaehler As Boolean
zeilen = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
spalten = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column + 1
For zeilenLauf = 1 To zeilen
For spaltenLauf = 1 To spalten
farbindex = GetCellColor(Cells(zeilenLauf, spaltenLauf))
Rem springt zu einer durch bedingte formatierung rot gefarbte zelle(farbindex rot) ,weiterer start,naechster fund usw.
If farbindex = 3 And zeileFest < zeilenLauf Or farbindex = 3 And spalteFest < spaltenLauf Then
Rem bzw jede durch eine bedingten formatierung hervorgerufene farbe
Rem If test > -1 And zeile < zaehler2 Or test > -1 And spalte < zaehler3 Then
Cells(zeilenLauf, spaltenLauf).Select
zeileFest = zeilenLauf
spalteFest = spaltenLauf
zaehler = True
Exit For
End If
Next spaltenLauf
If zaehler = True Then Exit For
Next zeilenLauf
If zaehler = False And spaltenLauf = spalten + 1 And zeilenLauf = zeilen + 1 Then
zeileFest = 0
spalteFest = 0
ende = MsgBox("Das ende wurde erreicht,es wird zum Anfang gesprungen" & Chr(13) _
& "bei erneuten Start !", vbQuestion)
End If
End Sub
Function GetCellColor(cell As Range) As Integer
Dim i
Dim myVal
Dim myColor As Integer
Dim done As Boolean
On Error Resume Next
Names("testname").Delete
On Error GoTo 0
Application.ReferenceStyle = xlR1C1
myVal = cell.Value
myColor = cell.Interior.ColorIndex
done = False
For i = 1 To cell.FormatConditions.Count
With cell.FormatConditions.Item(i)
If .Type = 1 Then
Select Case .Operator
Case xlBetween
If (myVal >= Evaluate(.Formula1) And myVal <= Evaluate(.Formula2)) _
Or (myVal <= Evaluate(.Formula1) And myVal >= Evaluate(.Formula2)) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlEqual
If myVal = Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlGreater
If myVal > Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlGreaterEqual
If myVal >= Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlLess
If myVal < Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlLessEqual
If myVal <= Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlNotBetween
If myVal < Evaluate(.Formula1) Or myVal > Evaluate(.Formula2) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlNotEqual
If myVal <> Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
End Select
ElseIf .Type = 2 Then
Names.Add Name:="testname", RefersToR1C1Local:=.Formula1
If Evaluate("testname") Then
myColor = .Interior.ColorIndex
done = True
End If
Names("testname").Delete
Else
MsgBox "Unbekannter Typ: " & .Type, , "PANIC: In
Function GetCellColor"
Exit Function
End If
End With
If done Then Exit For
Next
Application.ReferenceStyle = xlA1
GetCellColor = myColor
End Function