|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Datas/Números/Strings)
|
|
 |
Título da Dica: Ordenando Strings - Muito Rapido
|
 |
|
|
|
Postada em 3/2/2003 por Felipe
Attribute VB_Name = "Sort_String"
Option Explicit
Sub SwapStrings(pbString1 As String, pbString2 As String)
Dim l_Hold As Long
CopyMemory l_Hold, ByVal VarPtr(pbString1), 4
CopyMemory ByVal VarPtr(pbString1), ByVal VarPtr(pbString2), 4
CopyMemory ByVal VarPtr(pbString2), l_Hold, 4
End Sub
Public Sub ShellSortAsc(SortArray() As String, AllLowerCase As Boolean)
'The fastets sort algorithm!
Dim sVal1 As String, sVal2 As String
Dim Row As Long
Dim MaxRow As Long
Dim MinRow As Long
Dim Swtch As Long
Dim Limit As Long
Dim Offset As Long
MaxRow = UBound(SortArray)
MinRow = LBound(SortArray)
Offset = MaxRow \ 2
Do While Offset > 0
Limit = MaxRow - Offset
Do
Swtch = False ' Assume no switches at this offset.
' Compare elements and switch ones out of order:
For Row = MinRow To Limit
If AllLowerCase Then
sVal1 = LCase(SortArray(Row))
sVal2 = LCase(SortArray(Row + Offset))
Else
sVal1 = SortArray(Row)
sVal2 = SortArray(Row + Offset)
End If
If sVal1 > sVal2 Then
Swap SortArray(Row), SortArray(Row + Offset)
Swtch = Row
End If
Next Row
' Sort on next pass only to where last switch was made:
Limit = Swtch - Offset
Loop While Swtch
' No switches at last offset, try one half as big:
Offset = Offset \ 2
Loop
End Sub
Public Sub ShellSortDesc(SortArray() As String, AllLowerCase As Boolean)
'The fastets sort algorithm!
Dim sVal1 As String, sVal2 As String
Dim Row As Long
Dim MaxRow As Long
Dim MinRow As Long
Dim Swtch As Long
Dim Limit As Long
Dim Offset As Long
MaxRow = UBound(SortArray)
MinRow = LBound(SortArray)
Offset = MaxRow \ 2
Do While Offset > 0
Limit = MaxRow - Offset
Do
Swtch = False ' Assume no switches at this offset.
' Compare elements and switch ones out of order:
For Row = MinRow To Limit
If AllLowerCase Then
sVal1 = LCase(SortArray(Row))
sVal2 = LCase(SortArray(Row + Offset))
Else
sVal1 = SortArray(Row)
sVal2 = SortArray(Row + Offset)
End If
If sVal1 < sVal2 Then
Swap SortArray(Row), SortArray(Row + Offset)
Swtch = Row
End If
Next Row
' Sort on next pass only to where last switch was made:
Limit = Swtch - Offset
Loop While Swtch
' No switches at last offset, try one half as big:
Offset = Offset \ 2
Loop
End Sub
Public Static Sub StrSort(Lines() As String, Ascending As Boolean, AllLowerCase As Boolean)
If Ascending Then
ShellSortAsc Lines(), AllLowerCase
Else
ShellSortDesc Lines(), AllLowerCase
End If
End Sub
Private Sub Swap(ByRef var1 As String, ByRef var2 As String)
Dim X As String
X = var1
var1 = var2
var2 = X
End Sub
|
|
|
|
|
