Eindeutiger Rang mit VBA

[Andreas]

Hallo NG,

folgendes Rang-Problem würde ich gerne innerhalb einer VBA Funktion lösen:

Ich habe eine Range (Array), welche Zahlen enthält. In einer zweiten Range sollen eindeutige Rangfolgen bzgl.der ersten Range ermittelt werden.

Beispiel:
In der Range("A1:E1") stehen die Werte (2, 5, 3, 3, 2). In der Range("A2:E2") sollen nun die eindeutigen Ränge absteigend berechnet werden. Wenn eine Zahl doppelt vorkommt, dann soll der Rang sequentiell erhöht werden. Das Ergebnis sollte also (4, 1, 2, 3, 5) lauten.

Wäre toll, wenn mir hier jemand helfen könnte.

Danke und viele Grüße
Andreas

[Claus Busch]

Hallo Andreas,

Post by Andreas
In der Range("A1:E1") stehen die Werte (2, 5, 3, 3, 2). In der Range("A2:E2") sollen nun die eindeutigen Ränge absteigend berechnet werden. Wenn eine Zahl doppelt vorkommt, dann soll der Rang sequentiell erhöht werden. Das Ergebnis sollte also (4, 1, 2, 3, 5) lauten.

probiers mal so:

Sub Rang()
Dim i As Long

Range("A2").Formula = "=Rank(A1,A1:E1)"
For i = 2 To 5
Cells(2, i).FormulaArray = "=RANK(" & Cells(1, i).Address & _
",$A$1:$E$1)+SUM((RANK($A1:" & Cells(1, i - 1).Address &
",$A$1:$E$1)" _
& "=RANK(" & Cells(1, i).Address & ",$A$1:$E$1))*1)"
Next
End Sub


Mit freundlichen Grüßen
Claus

[Claus Busch]

Hallo Andreas,

Post by Claus Busch
Sub Rang()

falls du Werte statt Formeln haben möchtest, probiere es so:

Sub Rang()
Dim i As Long

Range("A2") = WorksheetFunction.Rank(Range("A1"), Range("A1:E1"))
For i = 2 To 5
Cells(2, i) = Evaluate("RANK(" & Cells(1, i).Address & _
",$A$1:$E$1)+SUM((RANK($A1:" & Cells(1, i - 1).Address &
",$A$1:$E$1)" _
& "=RANK(" & Cells(1, i).Address & ",$A$1:$E$1))*1)")
Next
End Sub


Mit freundlichen Grüßen
Claus

[Carlos Naplos]

Hallo Claus

Vielen Dank für Deine Anregungen.
Ich bin noch nicht dazu gekommen, sie auszuprobieren. Andere Themen
haben sich vorgedrängt. Ich hoffe, dass ich Ende dieser, Anfang nächster
Woche nochmal hier dran komme.
Fürs erste habe ich manuell mit Hilfsspalten und SVERWEIS improvisiert.

Ich habe, wie gesagt, in eine sql-Datenbank eine Liste mit ID und
übergeordneter ID. Die Liste (Menü) möchte ich in einer Baumstruktur
geordnet haben.

Da ich nur vier Ebenen habe bin ich mit vier Spalten (ID, PID, PPID,
PPPID) zurecht gekommen.

Interessant fände ich eine allgemeinere Lösung, so zu sortieren, dass
bevor der nächste Punkt kommt, zuerst alle Unterpunkte gelistet werden.

Dein Makro muss mir in Ruhe mal anschauen. Ich melde mich dann hier wieder.

lg
Carlos

Post by Claus Busch
Hallo Andreas,

Post by Claus Busch
Sub Rang()

Sub Rang()
Dim i As Long
Range("A2") = WorksheetFunction.Rank(Range("A1"), Range("A1:E1"))
For i = 2 To 5
Cells(2, i) = Evaluate("RANK(" & Cells(1, i).Address & _
",$A$1:$E$1)+SUM((RANK($A1:" & Cells(1, i - 1).Address &
",$A$1:$E$1)" _
& "=RANK(" & Cells(1, i).Address & ",$A$1:$E$1))*1)")
Next
End Sub
Mit freundlichen Grüßen
Claus

[Carlos Naplos]

Na so ein Mist. Jetzt habe ich die Antwort an den falschen Thread gehängt.

An alle Leser: ignoriert den Vorgänger dieses Postings.

Knirch
Carlos

Post by Carlos Naplos
Hallo Claus
Vielen Dank für Deine Anregungen.
Ich bin noch nicht dazu gekommen, sie auszuprobieren. Andere Themen
haben sich vorgedrängt. Ich hoffe, dass ich Ende dieser, Anfang nächster
Woche nochmal hier dran komme.
Fürs erste habe ich manuell mit Hilfsspalten und SVERWEIS improvisiert.
Ich habe, wie gesagt, in eine sql-Datenbank eine Liste mit ID und
übergeordneter ID. Die Liste (Menü) möchte ich in einer Baumstruktur
geordnet haben.
Da ich nur vier Ebenen habe bin ich mit vier Spalten (ID, PID, PPID,
PPPID) zurecht gekommen.
Interessant fände ich eine allgemeinere Lösung, so zu sortieren, dass
bevor der nächste Punkt kommt, zuerst alle Unterpunkte gelistet werden.
Dein Makro muss mir in Ruhe mal anschauen. Ich melde mich dann hier wieder.
lg
Carlos

Post by Claus Busch
Hallo Andreas,

Post by Claus Busch
Sub Rang()

Sub Rang()
Dim i As Long
Range("A2") = WorksheetFunction.Rank(Range("A1"), Range("A1:E1"))
For i = 2 To 5
Cells(2, i) = Evaluate("RANK(" & Cells(1, i).Address & _
",$A$1:$E$1)+SUM((RANK($A1:" & Cells(1, i - 1).Address &
",$A$1:$E$1)" _
& "=RANK(" & Cells(1, i).Address & ",$A$1:$E$1))*1)")
Next
End Sub
Mit freundlichen Grüßen
Claus

[Andreas]

Post by Claus Busch
Sub Rang()
Dim i As Long
Range("A2") = WorksheetFunction.Rank(Range("A1"), Range("A1:E1"))
For i = 2 To 5
Cells(2, i) = Evaluate("RANK(" & Cells(1, i).Address & _
",$A$1:$E$1)+SUM((RANK($A1:" & Cells(1, i - 1).Address &
",$A$1:$E$1)" _
& "=RANK(" & Cells(1, i).Address & ",$A$1:$E$1))*1)")
Next
End Sub

Hallo Claus,

deine Vorschläge funktionieren beide prima. Vielen Dank dafür.

Ich habe den Summenteil durch einen Zählenwenn-Teil ersetzt. Ich finde das noch etwas intuitiever, ist aber Geschmackssache, außer du sagst mit, dass eins von beiden unter Performance-Gesichtspunkten zu bevorzugen ist. Ich werde diese Funktion nämlich für das Ranking von Tausenden Werten benutzen.
Außerdem habe ich das ganze jetzt in eine Funktion gepackt, die die auszuwertende Zelle als auch den Bezug variabel verarbeiten kann, so wie man es von der eigentlichen RANG Funktion gewohnt ist.

Function RangSequentiell(Zahl As Range, Bezug As Range, Optional Reihenfolge As Integer = 0) As Integer

RangSequentiell = _
Evaluate("RANK(" & Zahl.Address(False, False) & "," & Bezug.Address & "," & Reihenfolge & _
") + COUNTIF(" & Bezug.Cells(1).Address(True, True) & ":" & Zahl.Address(False, False) & "," & Zahl.Address(False, False) & ")-1")

End Function

Viele Grüße
Andreas

[Claus Busch]

Hallo Andreas,

Post by Andreas
Außerdem habe ich das ganze jetzt in eine Funktion gepackt, die die auszuwertende Zelle als auch den Bezug variabel verarbeiten kann, so wie man es von der eigentlichen RANG Funktion gewohnt ist.

dann musst du eine Formel im Blatt benutzen und bei der großen Anzahl an
Werten wird es dann extrem langsam. Ich würde die Prozedur bevorzugen.


Mit freundlichen Grüßen
Claus