Sortierung Array-Variable mit Index

Question

Hallo,

nachdem mir hier:

https://supportnet.de/t/2332332

schon mal super geholfen wurde habe ich noch ein zweites Problem das ich selbst nicht so hinbekomme oder zumindest nicht so, dass der Code schnell und effektiv ist.

Es geht um ein Sortierproblem, bei dem allerdings nicht nur sortiert werden soll sondern ich brauche auch noch einen Index dazu.

Gegeben wäre also eine Array-Variable. Inhalt der Variable sind nur Zahlen.

DIM Memory (100, 100)

Die 100 sind leider nicht fix sondern es können auch mal nur 50 oder 20 sein!

Beispiel
(Sortiert werden soll nach dem 1. Feld und das 2. Feld soll mitgezogen werden):

1, 1
6, 2
5, 3
8, 4
7, 5
3, 6
5, 7
4, 8
2, 9

Gewünschtes Ergebnis:
1, 1
2, 9
3, 6
4, 8
5, 7
6, 2
7, 5
8, 4

Das ganze muss schnell gehen, also als VBA-Routine mit Variablen und nicht als "Nachbau" der in Excel ingegrierten Tabellensortierung.

UNd da ist eben mein Problem, das ich das als VBANull nicht hinbekomme und Hilfe benötige ...

Gruss
Klaus

Answer 1

achso, wenn möglich bitte für Excel 2010 ...

Answer 2

Hallo,

deine Angabe

Beispiel
(Sortiert werden soll nach dem 1. Feld und das 2. Feld soll mitgezogen werden):

1, 1
6, 2
5, 3.....

ist zu unpräzisse, da du ein Feld von 100*100 hast, wo ist Feld 1 und 2 in der Matrix


Gruß

Helmut

Answer 3

Sorry!

das Koma ist kein Dezimalkoma sondern das Feldtrennzeichen ...

;-)

Answer 4

Hallo,

du kennst deine Tabelle und wir nur das hier Geschriebene und daraus kann ich keine Zusammenhänge zwischen Feld 1 und 2 und deinen Zahlen bzw. den Orten der Zahlen in deinem Array herstellen. Da hielt auch die Angaben des Feldtrennzeichens recht wenig.

Könnte aber mit der Sortierfunktion gehen.

Gruß

Helmut

Answer 5

OK, die Aufgabenstellung ist schon wohl nicht so der Hit

Es müssen wohl zwei Array-Variablen sein

Dim Das_soll_sortiert_werden(10)
DIM Index = (10)

Das_soll_sortiert_werden(1) = 9
Das_soll_sortiert_werden(2) = 7
Das_soll_sortiert_werden(3) = 5
Das_soll_sortiert_werden(4) = 3
Das_soll_sortiert_werden(5) = 1
Das_soll_sortiert_werden(6) = 10
Das_soll_sortiert_werden(7) = 8
Das_soll_sortiert_werden(8) = 6
Das_soll_sortiert_werden(9) = 4
Das_soll_sortiert_werden(10) = 2

Index(1) = 1
Index(2) = 2
Index(3) = 3
Index(4) = 4
Index(5) = 5
Index(6) = 6
Index(7) = 7
Index(8) = 8
Index(9) = 9
Index(10) = 10


Das Ergebnis (nicht der VBA-Code) soll dann wie folgt ausgucken:

Das_soll_sortiert_werden(1) = 1
Das_soll_sortiert_werden(2) = 2
Das_soll_sortiert_werden(3) = 3
Das_soll_sortiert_werden(4) = 4
Das_soll_sortiert_werden(5) = 5
Das_soll_sortiert_werden(6) = 6
Das_soll_sortiert_werden(7) = 7
Das_soll_sortiert_werden(8) = 8
Das_soll_sortiert_werden(9) = 9
Das_soll_sortiert_werden(10) = 10

Index (1) =5
Index (2) = 10
Index (3) = 4
Index (4) = 9
Index (5) = 3
Index (6) = 8
Index (7) = 2
Index (8) = 7
Index (9) = 1
Index (10) = 6

Besser kann ich es nicht mehr beschreiben. Ich mach mich aber jetzt mal selbst auf die Socken und leg ne Nachtsitzung ein wenn ich vom Training zurückkomme ...

Gruss
Klaus

Answer 6

Hallo Klaus,

kein Makro läuft schneller, als die Excel-Sortierfunktion.

Wenn Du aber auf eine VBA-Lösung bestehst, dann zeichne die sonst von Hand ausgeführte Sortierroutine mit dem Makrorecorder auf und starte diesen Code so oft Du ihn benötigst.

Gruss
Rainer

Answer 7

hi all :-)

ein array laesst sich nicht mit bordmitteln sortieren !!!

daher hat sich ganz gut quicksort etabliert

gruss nighty

'Option Compare Binary ' keep case

'Option Compare Text ' ignore case

Sub TestIt()
Dim ar(2 To 5) As Variant, i As Long
For i = 2 To 5
ar(i) = Cells(i, 1)
Next
QuickSort_Feld ar, 2, 5, False
For i = 2 To 5
Cells(i, 2) = ar(i)
Next
End Sub

Private Sub QuickSort_Feld(DasFeld, StartUnten, EndeOben, Absteigend As Boolean)
Dim iUnten As Long, iOben, iMitte, y
iUnten = StartUnten
iOben = EndeOben
iMitte = DasFeld((StartUnten + EndeOben) / 2)
While (iUnten <= iOben)
If Not Absteigend Then
While (DasFeld(iUnten) < iMitte And iUnten < EndeOben)
iUnten = iUnten + 1
Wend
While (iMitte < DasFeld(iOben) And iOben > StartUnten)
iOben = iOben - 1
Wend
Else
While (DasFeld(iUnten) > iMitte And iUnten < EndeOben)
iUnten = iUnten + 1
Wend
While (iMitte > DasFeld(iOben) And iOben > StartUnten)
iOben = iOben - 1
Wend
End If
If (iUnten <= iOben) Then
y = DasFeld(iUnten)
DasFeld(iUnten) = DasFeld(iOben)
DasFeld(iOben) = y
iUnten = iUnten + 1
iOben = iOben - 1
End If
Wend
If (StartUnten < iOben) Then Call QuickSort_Feld(DasFeld, StartUnten, iOben, Absteigend)
If (iUnten < EndeOben) Then Call QuickSort_Feld(DasFeld, iUnten, EndeOben, Absteigend)
End Sub

@klaus
zudem eine sortierung mit kleiner groesser recht leicht zu gestalten ist

Answer 8

hi klaus :-)

es lassen sich natuerlich auch mehrdimensionale arrays sortieren,aber anstatt umzupacken ist manchmal ein zweites gleichgrosses array der leichtere weg zum anfang

redim preserve ist dann nicht mehr nutzbar,darum ein gleichgrosses array

quicksort ist fuer eindimensionale arrays gedacht

sollten noch probs aufrauchen bei einem mehrdimensionalen array das sortiert werden soll und du nicht klarkommst,schick mir eine musterdatei mit dem genutzten makro

oberley@t-online.de

gruss nighty

p.s.
wie gehabt,ich liebe spams

Answer 9

Hallo nighty,

vielen Dank!

Das Makro funktioniert und ich kapiere auch wie es funktioniert!

Ich werde jetzt das Ding noch erweitern um ein zweites Array das "mitgezogen" wird.

Wenns geklappt hat sage ich Bescheid und wen nicht melde ich mich sowieso nochmal. ;-)

Gruss
Klaus

Answer 10

So hier noch der erweiterte VBA-Code

DIese VBA-Routine wird benötigt, da sehr oft sortiert wird und sich die Werte zum Sortieren bereits in einer VBA-Variable befinden. Würde man die Excel-Tabellen-Sortierfunktion verwenden wollen müßte man erst alles in ein Tabellenblatt schreiben - und danach das sortierte Ergebnis wieder in die Array-Variable einlesen.

Und das ist trotz diverser Tricks sehr zeitaufwendig. Daher der ganze Aufwand ...



Zu Demozwecken werden die Felder der Excel-Tabelle automatisch gefüllt

Index_neu ist die Plazierung des sortierten Wertes vor dem Sortieren

Nochmals Muchas grazies an nighty!!!

SPAM kommt auch noch! ;-)




Sub Array_mit_Index_sortieren()

' Attentione: Ggf. vorhandene Werte in der Excel-Tabelle werden
' ohne weiteres Nachfragen überschreiben

Range("A1").Select
ActiveCell.FormulaR1C1 = "Zum Sortieren"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Index_alt"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Sortiert"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Index_neu"
Range("A2").Select
ActiveCell.FormulaR1C1 = "154"
Range("A3").Select
ActiveCell.FormulaR1C1 = "853"
Range("A4").Select
ActiveCell.FormulaR1C1 = "654"
Range("A5").Select
ActiveCell.FormulaR1C1 = "954"
Range("A6").Select
ActiveCell.FormulaR1C1 = "354"
Range("A7").Select
ActiveCell.FormulaR1C1 = "856"
Range("A8").Select
ActiveCell.FormulaR1C1 = "458"
Range("A9").Select
ActiveCell.FormulaR1C1 = "658"
Range("A10").Select
ActiveCell.FormulaR1C1 = "745"
Range("B2").Select
ActiveCell.FormulaR1C1 = "1"
Range("B3").Select
ActiveCell.FormulaR1C1 = "2"
Range("B4").Select
ActiveCell.FormulaR1C1 = "3"
Range("B5").Select
ActiveCell.FormulaR1C1 = "4"
Range("B6").Select
ActiveCell.FormulaR1C1 = "5"
Range("B7").Select
ActiveCell.FormulaR1C1 = "6"
Range("B8").Select
ActiveCell.FormulaR1C1 = "7"
Range("B9").Select
ActiveCell.FormulaR1C1 = "8"
Range("B10").Select
ActiveCell.FormulaR1C1 = "9"


Dim i As Long
Dim ar(2 To 10) As Variant
Dim ar2(2 To 10) As Variant

For i = 2 To 10
ar(i) = Cells(i, 1)
ar2(i) = Cells(i, 2)
Next

QuickSort_Field ar, ar2, 2, 10, False

For i = 2 To 10
Cells(i, 3) = ar(i)
Cells(i, 4) = ar2(i)
Next

Cells.Select
Selection.Columns.AutoFit

End Sub

Private Sub QuickSort_Field(DasFeld, DasFeld2, StartUnten, EndeOben, Absteigend As Boolean)
Dim iUnten As Long, iOben, iMitte, y
iUnten = StartUnten
iOben = EndeOben
iMitte = DasFeld((StartUnten + EndeOben) / 2)
While (iUnten <= iOben)
If Not Absteigend Then
While (DasFeld(iUnten) < iMitte And iUnten < EndeOben)
iUnten = iUnten + 1
Wend
While (iMitte < DasFeld(iOben) And iOben > StartUnten)
iOben = iOben - 1
Wend
Else
While (DasFeld(iUnten) > iMitte And iUnten < EndeOben)
iUnten = iUnten + 1
Wend
While (iMitte > DasFeld(iOben) And iOben > StartUnten)
iOben = iOben - 1
Wend
End If
If (iUnten <= iOben) Then
y = DasFeld(iUnten)
y2 = DasFeld2(iUnten)
DasFeld(iUnten) = DasFeld(iOben)
DasFeld2(iUnten) = DasFeld2(iOben)
DasFeld(iOben) = y
DasFeld2(iOben) = y2
iUnten = iUnten + 1
iOben = iOben - 1
End If
Wend
If (StartUnten < iOben) Then Call QuickSort_Field(DasFeld, DasFeld2, StartUnten, iOben, Absteigend)
If (iUnten < EndeOben) Then Call QuickSort_Field(DasFeld, DasFeld2, iUnten, EndeOben, Absteigend)
End Sub