Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.09.2025 22:18:24
Liste mit Links - tricky
26.09.2025 18:34:36
Welches Datum gibt mein M-Code aus?
26.09.2025 10:29:46
Wert aus einer Zelle bei jeder Eingabe in neue Zelle
26.09.2025 08:51:00
Teilinhalt einer Zelle vergleichen
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
404to408
404to408
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

5 besten Ergebnisse sollen markiert werden

Forumthread: 5 besten Ergebnisse sollen markiert werden

5 besten Ergebnisse sollen markiert werden
Andreas
Hallo,
ich brauche mal wieder eure hilfe und zwar sollen die besten 5 ergebnisse aus einem bereich markiert (fett gedruckt) werden.
dabei habe ich das problem, das einige ergebnisse mehrfach auftauchen können, sodass, wenn eine zelle schon Fett ist, weitergesucht werden soll und die nächste Zelle dann ausgewählt werden soll.
Gruß
Andreas
https://www.herber.de/bbs/user/4654.xls
Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: 5 besten Ergebnisse sollen markiert werden
ChrisL
Hi Andreas
Viel Spass damit...
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zeile As Long, iSpalte As Byte
Dim Arr(), iArr As Integer
Dim PositionMax As Integer
If Target.Column >= 3 And Target.Column <= 16 And _
Target.Row >= 2 And Target.Row <= 5 Then
Zeile = Target.Row
For iSpalte = 3 To 16
If Cells(Zeile, iSpalte) = "" Then Exit For
ReDim Preserve Arr(0 To iSpalte - 3)
Arr(UBound(Arr)) = Cells(Zeile, iSpalte)
Next iSpalte
Range(Cells(Zeile, 19), Cells(Zeile, 23)).ClearContents
Range(Cells(Zeile, 3), Cells(Zeile, 16)).Font.Bold = False
iSpalte = 19
Do Until iSpalte > 23
For iArr = UBound(Arr) To 0 Step -1
If Arr(iArr) = WorksheetFunction.Max(Arr) Then
PositionMax = iArr
Exit For
End If
Next iArr
Cells(Zeile, PositionMax + 3).Font.Bold = True
Cells(Zeile, iSpalte) = Arr(PositionMax)
Arr(PositionMax) = 0
iSpalte = iSpalte + 1
If iSpalte > 23 Then Exit Sub
Loop
End If
End Sub

Gruss
Chris
https://www.herber.de/bbs/user/4663.xls
Anzeige
AW: 5 besten Ergebnisse sollen markiert werden
Andreas
Vielen Dank Chris
werde es mal ausprobieren
Gruß
Andreas
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige