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
Anzeige