Sortera en vektor?

[Tobias5]

Kan man på något sätt sortera en egendefinerad vektor i vb? alltså:

dim exempel(500) as variant

exempel(0) = 'kalle'

exempel(1) = 'örjan'

exempel(2) = 'arne'

typ: sort exempel desc?

[SvenPon]

Hej Testa detta exempel QuickSort

 

'SvenPon 2000-03-21

'När Ni skall använd algoritmen praktiskt i Era projekt

'så laddar ni dData på lämpligt vis tex For sats.

'Sätt rätt sort på As tex As String om det är text

'Ni som har snabba processorer får trixa till tidmätningen

'med något lämligt API

Option Explicit

DefLng A-Z

Dim dData(30000) As Double

Private Sub Command1_Click()

Dim i, totElements, T1 As Single, T2 As Single, srtTime As Single

totElements = HScroll1.Value

'slumpar in double:s i dData

For i = 0 To totElements - 1

dData(i) = Rnd(2) * 1000

Next

Screen.MousePointer = vbHourglass

T1 = Timer

'QSort kör med rekursivt anrop

'när den kommit igång

Call QSort(0, totElements)

T2 = Timer

srtTime = (T2 - T1) / 1000

Label4 = Format(srtTime, "0.00000") & " sek"

Screen.MousePointer = vbDefault

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

Private Sub Form_Load()

Label1 = "Storlek på Array som skall sorteras " _

& Format$(HScroll1.Value, "####")

End Sub

Private Sub HScroll1_Change()

Label1 = "Storlek på Array som skall sorteras: " _

& Format$(HScroll1.Value, "####")

End Sub

Private Sub QSort(lower As Long, upper As Long)

Dim pivot As Double, temp As Double

Dim first, last, middle

' deklarera mittpunkt i dData "pivot"

first = lower ' lägsta pekare

last = upper ' högsta pekare

middle = (first + last) / 2

pivot = dData(middle)

Do ' kör pekarna mot varandra

While dData(first) < pivot

first = first + 1

Wend

While dData(last) > pivot

last = last - 1

Wend

If first <= last Then

temp = dData(first)

dData(first) = dData(last)

dData(last) = temp

first = first + 1

last = last - 1

End If

Loop Until first > last

If lower < last Then

'Rekursiva anrop

Call QSort(lower, last)

End If

If first < upper Then

Call QSort(first, upper)

End If

End Sub

 

[Dahlander]

Det finns oändligt många olika sorteringsalgoritmer. Vissa betydligt snabbare än andra. Är det bara ett fåtal poster - säg några tusen så går det lika bra med vilken som. Detta är en enkel

 

Sub SorteraArray(ByRef arr As Variant)

Dim i As Long

Dim j As Long

Dim tmp As Variant

 

For i = 1 To UBound(arr) - 1

For j = 1 To UBound(arr) - 1

If arr(j) > arr(j + 1) Then

tmp = arr(j)

arr(j) = arr(j + 1)

arr(j + 1) = tmp

End If

Next j

Next i

End Sub