Supportnet / Forum / Tabellenkalkulation

Wer kann mir helfen? Ich möchte mit VBA die 5 größten Werte einer Excel Spalte heraussuchen Vielen Dank schonmal für jede Antwort!

Hallo,

geht auch mit

=KGRÖSSTE(A1:A1000; Zeile())
ateht in B1 und dann nach unten ziehen. In A1 : A1000 stehen deine Werte

Gruß

Helmut

Hi!

Mit den Bezügen A1:A1000 auspassen.
Ev. $a$1:$A$1000

Klaus

Danke für eure Antworten!

aber habt ihr ne Idee wieich es direkt in VBA lösen kann. ich brauche die 5 größten Werte umdie dann in einem Makro verarbeiten zu können. Gibt es da was im Zusammenhang mit find?

DAnke nochmal!

Hallo,

versuch es mal so:

Sub fünf_grössten()
Dim arr() As Byte, i As Byte, Zeile As Long
Zeile = Cells(Rows.Count, 1).End(xlUp).Row
ReDim arr(5)
For i = 1 To 5
arr(i) = Application.WorksheetFunction.Large(Range(Cells(1, 1), Cells(Zeile, 1)), i)
Next
MsgBox arr(1) & "-" & arr(2) & "-" & arr(3) & "-" & arr(4) & "-" & arr(5)
End Sub

Es werden die 5 höchsten Werte in Spalte A gesucht, und in absteigender Sortierung dem arr(i) zugeordnet. Die Variablen arr(1) - arr(5) kanst du dann weiter verwenden.

MfG

JöKe

Vielen DANK!!!
ich probiers morgen mal aus!

Simon

Hallo,

ich habe es so zum Laufen bekommen (und wundere mich wieder einmal, dass es bei anderen scheinbar ohne ActiveSheet. ?? läuft):

Sub die_fünf_grössten_in_A()
Dim arr() As Byte, i As Byte, Zeile As Long
Zeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ReDim arr(5)
For i = 1 To 5
arr(i) = Application.WorksheetFunction.Large(ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(Zeile, 1)), i)
Next
MsgBox arr(1) & "-" & arr(2) & "-" & arr(3) & "-" & arr(4) & "-" & arr(5)
End Sub

Gruß,
CaroS

Hallo,

kleiner Nachtrag, siehe Makroname:

Sub die_fünf_grössten_verschiedenen_in_A()
Dim arr() As Byte, i As Byte, k As Long, Zeile As Long
Zeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ReDim arr(5)
arr(1) = Application.WorksheetFunction.Large(ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(Zeile, 1)), 1)
k = 1
For i = 2 To 5
Do
k = k + 1
If Application.WorksheetFunction.Large(ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(Zeile, 1)), k) < arr(i - 1) Then Exit Do
Loop Until k = Zeile
arr(i) = Application.WorksheetFunction.Large(ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(Zeile, 1)), k)
Next

MsgBox arr(1) & "-" & arr(2) & "-" & arr(3) & "-" & arr(4) & "-" & arr(5)
End Sub

Das ist noch nicht perfekt, wenn es nicht genug verschiedene gibt, aber das kriegt man bei Bedarf auch noch hin.

Gruß,
CaroS

Hallo,

sorry, da habe ich eben glatt meine vorletzte Variante gepostet. Die funktioniert zwar genauso, sollte aber gar nicht "raus". Hier also meine (vorläufig) letzte mit Hilfsvariable h und dafür ohne doppelten Funktionsaufruf:

Sub die_fünf_grössten_verschiedenen_in_A()
Dim arr() As Byte, h As Byte, i As Byte, k As Long, Zeile As Long
Zeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ReDim arr(5)
arr(1) = Application.WorksheetFunction.Large(ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(Zeile, 1)), 1)
k = 1
For i = 2 To 5
Do
k = k + 1
h = Application.WorksheetFunction.Large(ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(Zeile, 1)), k)
If h < arr(i - 1) Then Exit Do
Loop Until k = Zeile
arr(i) = h
Next
MsgBox arr(1) & "-" & arr(2) & "-" & arr(3) & "-" & arr(4) & "-" & arr(5)
End Sub

Gruß,
CaroS

Danke für die Hilfe, hatte leider noch keine Zeit es ausprobieren!
DANKE

• Felder in excel?
• Tabelle sortieren
• negative Zahl in Zelle
• Excel Werte vergleichen
• TOP 3 markieren - bedingte Formatierung