Sub Christina()
Dim rng As Range, rngAll As Range
Dim vntRet As Variant
Set rngAll = Range("B6:B" & Application.Max(6, Cells(Rows.Count, 2).End(xlUp).Row))
rngAll.Interior.ColorIndex = xlNone
On Error Resume Next
For Each rng In rngAll
If IsNumeric(rng) Then
If rng = Application.Large(rngAll, 1) Then rng.Interior.ColorIndex = 4
If rng = Application.Large(rngAll, 2) Then rng.Interior.ColorIndex = 5
If rng = Application.Large(rngAll, 3) Then rng.Interior.ColorIndex = 6
If rng = Application.Large(rngAll, 4) Then rng.Interior.ColorIndex = 3
End If
Next
On Error GoTo 0
Set rngAll = Nothing
End Sub
Sub Bedingte_Formatierung()
Dim z As Integer
For z = 6 To 14
If Cells(z, 2) = Application.Large(Range("B6:B14"), z - 5) Then Cells(z, 2).Interior.ColorIndex _
= 5
If Cells(z, 2) = Application.Large(Range("B6:B14"), z - 4) Then Cells(z, 2).Interior.ColorIndex _
= 8
If Cells(z, 2) = Application.Large(Range("B6:B14"), z - 3) Then Cells(z, 2).Interior.ColorIndex _
= 11
If Cells(z, 2) = Application.Large(Range("B6:B14"), z - 2) Then Cells(z, 2).Interior.ColorIndex _
= 14
Next z
End Sub
Sub Christina()
Dim rng As Range, rngAll As Range
Dim dblValues(3) As Double, lngIndex As Long, lngC As Long
Set rngAll = Range("B6:B" & Application.Max(6, Cells(Rows.Count, 2).End(xlUp).Row))
rngAll.Interior.ColorIndex = xlNone
On Error Resume Next
Do
lngC = lngC + 1
If IsError(Application.Match(Application.Large(rngAll, lngC), dblValues, 0)) Then
dblValues(lngIndex) = Application.Large(rngAll, lngC)
lngIndex = lngIndex + 1
End If
Loop While lngIndex < 4
For Each rng In rngAll
Select Case rng
Case dblValues(0): rng.Interior.ColorIndex = 4
Case dblValues(1): rng.Interior.ColorIndex = 5
Case dblValues(2): rng.Interior.ColorIndex = 6
Case dblValues(3): rng.Interior.ColorIndex = 3
End Select
Next
On Error GoTo 0
Set rngAll = Nothing
End Sub