Hi zusammen,

es geht um eine Funktion, welche nach dem größten (oder kleinsten) Wert sucht und diesen rot oder grün einfärbt. Das funktioniert auch, wenn bereits die Tabelle gefiltert wurde.

Unten der Quellcode der Funktion. Sie arbeitet auch wie gewünscht. (Auch dank dieses mega Forums hier). Aber sie hat ihre Schwächen.

Problem 1: Sie färbt immer nur den ersten Wert, welchen sie findet ein. D.h. wenn der größte Wert 1000g sind und er 10 mal auftaucht, färbt er aber nur den ersten Wert ein. Es wäre super, wenn er alle 1000g Werte einfärben würde.

Problem 2: Die funktion berücksichtigt keine durch Formeln errechnete Werte. Eine Spalte enthät das Volumen von Objeketen, welches excel errechnet, aber hier get die Funktion nicht.

Problem 3: Es kommt zum Bug, wenn eine Nicht-zahl oder so dabei ist. Kann man was machen, dass er "falsche" Werte ignoriert?

Vielen Dank vorab,

Verena

ActiveSheet.ListObjects("DatenTabelle").ListColumns("Gewicht").DataBodyRange.SpecialCells(xlCellTypeVisible).Select
                Call Analyze_Max_Bad

Sub Analyze_Max_Bad()
            Dim strData As String
                    Dim rng As Range
                    Dim vValue As Variant
                    Dim rngCol As Range
                    Dim lngRow As Long
                    Dim rngAdd As Range
                    strData = Selection.Address
                    Set rng = Range(strData)
                    vValue = Application.WorksheetFunction.Max(rng)
                    For Each rngCol In rng.Columns
                        If Application.WorksheetFunction.CountIf(rngCol, vValue) > 0 Then
                            lngRow = Application.WorksheetFunction.Match(vValue, rngCol, 0)
                            Set rngAdd = rngCol.Cells(lngRow, 1)
                            rngAdd.Select
                        End If
                    Next
                        With Selection
                        .Interior.Color = vbRed
                    End With
        End Sub

        End Sub