mehrere Max Wete Ermittel

[freddy]

Hallo zusammen
habe folgendes Problem ich versuche in mehreren Zeilen und Spalten mit der Funktion Worksheets Funktion Max die größten Werte zu ermitteln was auch Klappt aber wenn in einer Zeile 2 oder mehrere gleiche vorkommen dann wird nur der erste Maxwert erfasst und Markiert ich bräuchte aber alle Werte

Hier mein Code:

Code:

Sub TagesBester()
With Sheets("Tipp_Auswertung")
  ErsteZeile = 5
  LetzteZeile = 38
  ErsteSpalte = 4
  LetzteSpalte = 14
 
    For Zeile = ErsteZeile To LetzteZeile
 
         Set Bereich = .Range(.Cells(Zeile, ErsteSpalte), .Cells(Zeile, LetzteSpalte))
'******************************************************************************************************
        
         BestWert = Application.WorksheetFunction.Max(Bereich)
         If BestWert <= 0 Then Exit Sub
         Set BestAdr = Bereich.Find(What:=BestWert, lookat:=xlValue)
    
         If BestWert > 0 Then
        .Cells(Zeile, BestAdr.Column).Interior.ColorIndex = 4
     End If
    
   Next Zeile
 End With
End Sub

Danke im voraus für die Hilfe

[RPP63]

Guten Morgen!
Ich würde es einfach mit der bedingten Formatierung machen.
Dann braucht es auch keine Schleife.
Als Makro:

Code:

Sub MitBedForm()
  With Sheets("Tipp_Auswertung").Range("D5:N38")
     .FormatConditions.Add Type:=xlExpression, Formula1:="=D5=MAX($D5:$N5)"
     .FormatConditions(1).Interior.ColorIndex = 4
  End With
End Sub

Gruß Ralf

[freddy]

Sub MitBedForm()
  With Sheets("Tipp_Auswertung").Range("D5:N38")
     .FormatConditions.Add Type:=xlExpression, Formula1:="=D5=MAX($D5:$N5)"
     .FormatConditions(1).Interior.ColorIndex = 4
  End With
End Sub

Hallo Ralf Danke

funktioniert fast es werden alle größten Werte Markiert auch wenn sie mehrfach vorkommen
Aber auch die leeren Zellen werden ebenfalls Markiert
habe es mit einer if abfrage versucht

mit

Code:

If .Range("D5:N38") < =0 Then
.FormatConditions(1)Interior.colorindex=2
end if

Da aber mault excel mit Typen Unverträglich bei If .Range("D5:N38") < =0

[GMG-CC]

Da aber mault excel mit Typen Unverträglich bei If .Range("D5:N38") < =0

Zu Recht, denn eine einzelne Zelle kann zwar einen Wert (Value) haben, eine Bereich (Range) nicht. Halte dich an Ralfs Vorschlag und ändere nur die Bedingung dahingehend ab, dass die Zelle dem Maximalwert des Bereichs entspricht UND (And) <>0 ist.

[RPP63]

Hi!
Mein Makro macht exakt das, was Du in #1 wolltest (leere Zellen werden bei mir NICHT markiert).
Jetzt sind negative Werte im Spiel sowie ein anderer ColorIndex.
Was hast Du genau vor?

Gruß Ralf

[freddy]

Servus Ralf

Danke für die Antwort
So wie Du in Deinem Makro ja den Bereich Festgelegt hast ist ja auch alles OK
aber ich hab in dem Bereich D5:N38 bisher nur in den ersten 3 Zeilen Werte
also von D5 bis N7 der andere Bereich ist noch leer und dieser wird mit Markiert
der andere Colorindex war nur ein Versuch das zu ändern

[RPP63]

Alles klar, Freddy!
Lösche die bed.Formatierung und ändere die Formel auf:
Formula1:="=(D5<>"""")*(D5=MAX($D5:$N5))"

Der Leerstring muss gedoppelt werden, die Multiplikation ()*() ist nichts anderes als eine UND-Bedingung.

Gruß Ralf

[freddy]

Servus Ralf

Hilft leider nix es werden immer noch die leeren Zellen Markiert

[RPP63]

Hmmmh!
Bei mir jedenfalls nicht!

EDIT:
Ach so:
Hast Du vorher die bed.Form. gelöscht???

Vorschlag zur Güte:
Du brauchst ja kein Makro, sondern kannst die bed.Form. ja auch per Hand eingeben.

- Bereich B5:N38 markieren,
- bed.Form. Formel ist: =(D5<>"")*(D5=MAX($D5:$N5))

   

Gruß Ralf

[freddy]

Hallo Ralf

Nun habe ich es hinbekommen

Code:

Sub TagesBester()
   With Sheets("Tipp_Auswertung").Range("D5:N38")
      .FormatConditions.Add Type:=xlExpression, Formula1:="=(D5>=0)*(D5=MAX($D5:$N5))"
      .FormatConditions(1).Interior.ColorIndex = 4
   End With
End Sub

Nur die Markierung lässt sich nicht Formatieren auch nicht im Entwurfs Modus
ist zwar nicht so Entscheidend ich kann es nur nicht verstehen
Über das Makro geht es wenn ich den ColorIndex ändere, Manuel aber Komischerweise nicht

Trotzdem Danke für die Hilfe :18: :18: