Function QuickSortString(memberArray As Variant) As Variant
On Error Goto Erro
Dim k As Integer, i As Integer, j As Integer, h As Integer, r As Integer
Dim temp As String
'Set up for Shell sort algorithm
k= Ubound(memberArray)
h = 1
Do While h < k
h = (h*3)+1
Loop
h = (h-1)/3
If h > 3 Then
h = (h-1)/3
End If
'Shell sort algorithm
Do While h > 0
For i = 1+h To k
temp = memberArray(i)
j = i-h
Do While j >0
'Para ordenar datas é necessário trocar o UCase da comparação por Cdat.
If Ucase(memberArray(j)) >Ucase(temp) Then
memberArray(j+h) = memberArray(j)
memberArray(j) = temp
Else
Exit Do
End If
j = j-h
Loop
Next i
h = (h-1)/3
Loop
QuickSortString = memberArray
Exit Function
Erro:
Msgbox "ScriptLibrary - SortList/QuickSortString - Erro: " & Error & " na Linha: " & Erl
Exit Function
End Function
Nenhum comentário:
Postar um comentário