vb6.0/vba [vb6.0/vba] 문자형(String) 배열 정렬(Sort) 함수
페이지 정보
본문
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
- 이전글[vb6.0/vba] vba를 활용하여 네이버 증권정보 현재가 가져오기 20.05.16
- 다음글[vba] Sort(내림차순, 오름차순) 기본 코드 (VBA 매크로) 20.05.02
댓글목록
등록된 댓글이 없습니다.