Snel sorteren

Status
Niet open voor verdere reacties.

Axel Hagg

Gebruiker
Lid geworden
23 nov 2006
Berichten
624
Met onderstaande sub kun je snel lijsten sorteren

Een lijst met één kolom Lijst(x) heeft r rijen:

SorteerLijst Lijst(), 0, de eerst te sorteren rij, de laatst te sorteren rij

Een lijst met meerdere kolommen Lijst(x, y):

SorteerLijst Lijst(), de te sorteren kolom, de eerst te sorteren rij, de laatst te sorteren rij



Public Sub SorteerLijst(fLijst() As String, fStatus As Byte, fMin As Integer, fMax As Integer)
Dim i As Integer
Dim l As Integer
Dim h As Integer
Dim k As Byte
Dim m As Integer
Dim r
Dim s

If fMin > fMax Then Exit Sub
If fStatus = 0 Then
m = (fMin + fMax) \ 2
s = fLijst(m)
l = fMin
h = fMax
Do
Do Until fLijst(l) >= s
l = l + 1
Loop
Do Until fLijst(h) <= s
h = h - 1
Loop
If l <= h Then
r = fLijst(l)
fLijst(l) = fLijst(h)
fLijst(h) = r
l = l + 1
h = h - 1
End If
Loop Until l > h
If h <= m Then
SorteerLijst fLijst(), fStatus, fMin, h
SorteerLijst fLijst(), fStatus, l, fMax
Else
SorteerLijst fLijst(), fStatus, l, fMax
SorteerLijst fLijst(), fStatus, fMin, h
End If
Else
h = fMax
k = LBound(fLijst) + fStatus - 1
l = fMin
m = (h + l) \ 2
s = fLijst(k, m)
Do
Do Until fLijst(k, l) >= s
l = l + 1
Loop
Do Until fLijst(k, h) <= s
h = h - 1
Loop
If l <= h Then
For i = LBound(fLijst) To UBound(fLijst)
r = fLijst(i, l)
fLijst(i, l) = fLijst(i, h)
fLijst(i, h) = r
Next
l = l + 1
h = h - 1
End If
Loop Until l > h
If h <= m Then
SorteerLijst fLijst(), fStatus, fMin, h
SorteerLijst fLijst(), fStatus, l, fMax
Else
SorteerLijst fLijst(), fStatus, l, fMax
SorteerLijst fLijst(), fStatus, fMin, h
End If
End If
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan