Sub bereichfaerben()
With ActiveSheet.ListObjects("DatenTabelle").ListColumns("Gewicht")
Call Analyze_Max_Bad(.DataBodyRange)
End With
End Sub
Function Analyze_Max_Bad(rngBereich As Range)
Dim rngArea As Range, rng As Range, rngAlle As Range
Dim vValue As Variant
vValue = Application.WorksheetFunction.Subtotal(4, rngBereich)
For Each rngArea In rngBereich.SpecialCells(xlCellTypeVisible)
For Each rng In rngArea
If IsNumeric(rng.Value) Then
If CDbl(rng.Value) = vValue Then
If rngAlle Is Nothing Then
Set rngAlle = rng
Else
Set rngAlle = Union(rngAlle, rng)
End If
End If
End If
Next
Next
If Not rngAlle Is Nothing Then rngAlle.Interior.Color = vbRed
Set rngAlle = Nothing: Set rngArea = Nothing: Set rng = Nothing
End Function