segunda-feira, 26 de julho de 2010

Retorna uma lista ordenada alfabeticamente

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