[vb6.0/vba] [vb6.0/vba] 문자형(String) 배열 정렬(Sort) 함수
하나를하더라도최선을
2020-05-02 13:28
3,880
0
본문
Private Function ShellSortStrings(ByRef StringData() As String) As Boolean
'-----------------------------------------------------------------------
' Procedure : frmMain.ShellSortStrings
' Author : GWilmot
' Date Created : 05/12/2002
'-----------------------------------------------------------------------
' Purpose : Sorts a single dimension array of strings in ascending
' Order, case insensitive
' Assumptions :
' Inputs : String Array
' Returns : True is succeeded & sorted Array, False if not
' Effects :
' Last Updated :
'-----------------------------------------------------------------------
Dim lsLocalData() As String ' Holds a local copy of the data
Dim i As Long ' For Counter
Dim lbSwapped As Boolean ' Flag to show that a value has been swapped
Dim lsBuffer As String ' Holding point
On Error GoTo Catch
' Set up our local copy (that way if we error - we leave it how we found it)
ReDim lsLocalData(LBound(StringData) To UBound(StringData))
For i = LBound(StringData) To UBound(StringData)
lsLocalData(i) = StringData(i)
Next i
Do
' Default
lbSwapped = False
For i = LBound(lsLocalData) To UBound(lsLocalData) - 1
If UCase$(lsLocalData(i)) > UCase$(lsLocalData(i + 1)) Then
' Watch the shells....
lsBuffer = lsLocalData(i)
lsLocalData(i) = lsLocalData(i + 1)
lsLocalData(i + 1) = lsBuffer
lbSwapped = True
End If
Next i
Loop Until Not lbSwapped
' Copy back
For i = LBound(StringData) To UBound(StringData)
StringData(i) = lsLocalData(i)
Next i
' Set the success flag
ShellSortStrings = True
Finally:
' Clean-up
Exit Function
Catch:
' Ignore error unless in debugmode
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ShellSortStrings of Form frmMain"
Resume Finally
End Function
댓글목록0