Datenfeld effektiv sortieren

[Quantum]

Hallo liebe Leute,

ich habe über eine For Schleife ein großes Datenfeld mit Zufallszahlen erzeugt. Wie könnte man mittels VBA dieses Feld möglichst effektiv sowie möglichst einfach sortieren?

Code:

Sub Sortierungsaufgabe()
ReDim afArray(1 To 10000)

'Datenfeld erzeugen
For i = 1 To UBound(afArray)
afArray(i) = WorksheetFunction.RandBetween(1, 10000) & " beliebige Zeichenkette dranhängen "
Next i

End Sub

[Steffl]

Hallo,

vielleicht mit Quicksort?

[Codespiker]

Alternativ Bubblesort, leichter aber langsamer.
Beide Algorithmen hier mal gegenübergestelllt:

https://msdn.microsoft.com/de-de/library/bb979305.aspx

[RPP63]

Moin!

Zunächst:
Dass "10000 beliebige Zeichenkette dranhängen "
kleiner ist als "9 beliebige Zeichenkette dranhängen "
ist Dir klar?

Ich lehne mich jetzt mal ganz weit aus dem Fenster … 
Array en bloc in eine Tabelle schreiben,
diese sortieren
und wieder zurück ins Array schreiben

Dürfte auch nicht spürbar langsamer sein als obige Vorschläge.

Ich lasse mich aber gerne eines Besseren belehren!


Gruß Ralf

[Steffl]

Hallo Ralf,

Dass "10000 beliebige Zeichenkette dranhängen "
kleiner ist als "9 beliebige Zeichenkette dranhängen "
ist Dir klar?

stimmt, das habe ich auch nach meinen Posting bemerkt.

[RPP63]

Ich fange mal an.  :19:
Mit Umweg über ein Sheet 0,2 Sekunden für die 10.000 Strings.
(Laptop mit Celeron, also keine Rakete)

Sub Sortierungsaufgabe()
Dim afArray(1 To 10000, 1 To 1)
Dim arrSort
Dim Start As Double, i As Long
Application.ScreenUpdating = False
'Datenfeld erzeugen 
For i = 1 To 10000
afArray(i, 1) = WorksheetFunction.RandBetween(1, 10000) & " beliebige Zeichenkette dranhängen "
Next i
'erst jetzt der Timer 
Start = Timer
Range("A1:A10000") = afArray
Cells(1).CurrentRegion.Sort Cells(1), xlAscending, Header:=xlNo
arrSort = Range("A1:A10000")
Erase afArray
Columns(1).ClearContents
Debug.Print Timer - Start
End Sub

Gruß Ralf

[Quantum]

Hallo liebe Leute,

[RPP63]

Moin!

Über ein Excel-Sheet zu gehen wollte ich eigentlich auch nicht, da man ja eigentlich ein bißchen schummelt und keinen eigenen Sortiercode entwickelt.

Und den hast Du jetzt mit Worksheetfunction.Match gefunden?  :21: :05:

Freundlicher Gruß,
Ralf

[Steffl]

Hallo,

mal meine Idee mit dem Quicksort (wobei ich die Lösung von Ralf vorziehen würde)

Code:

Sub Einfaches_sortieren_eines_Arrays()
ReDim afarray(1 To 10000)
Dim i As Long

'Datenfeld erzeugen
For i = 1 To UBound(afarray)
afarray(i) = WorksheetFunction.RandBetween(1, 10000) & " Zeichenkette beliebig "
Next i

QuickSort_Feld afarray, 1, UBound(afarray), False

End Sub


Private Sub QuickSort_Feld(DasFeld, StartUnten, EndeOben, _
Absteigend As Boolean)
'QuickSort Standard
'Autor:Peter Haserodt
'www.online-excel.de
'bei den Änderungen sind die Originalcodezeilen auskommentiert und durch meinen Murks ersetzt
Dim iUnten As Long, iOben, iMitte, y
iUnten = StartUnten
iOben = EndeOben
' iMitte = DasFeld((StartUnten + EndeOben) / 2)
iMitte = Val(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
   While (Val(DasFeld(iUnten)) < iMitte And iUnten < EndeOben)
    iUnten = iUnten + 1
   Wend
   While (iMitte < Val(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
   While (Val(DasFeld(iUnten)) > iMitte And iUnten < EndeOben)
    iUnten = iUnten + 1
   Wend
   While (iMitte > Val(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

[RPP63]

Ich verstehe nicht, warum Quantum seinen Code wieder gelöscht hat.
Schließlich habe ich ihn nicht angegriffen, sondern nur einen kleinen Scherz bzgl. der Worksheetfunction gemacht.

Zur Klarstellung:
Wann immer es möglich ist, sollte man auch in VBA die Funktionalitäten von Excel nutzen! Dazu gehören natürlich auch die eingebauten Funktionen.
Schließlich programmieren die Redmonder hardwarenah, da muss nichts mehr kompiliert werden.
Daher ist meist ein Geschwindigkeitsvorteil zu erhalten, den man auch nutzen sollte.

My two cents
Ralf