'快速排序
Public Function QuickSortASC(vData As Variant, Low As Long, Hi As Long) As Boolean
   If Not IsArray(vData) Then Exit Function
  
   Dim lTmpLow As Long
   Dim lTmpHi As Long
   Dim lTmpMid As Long
   Dim vTempVal As Long
   Dim vTmpHold As Long
   On Error GoTo QuickSort
   QuickSortASC = False
  
   lTmpLow = Low
   lTmpHi = Hi
  
   If Hi <= Low Then Exit Function
  
   If lTmpMid = 0 Then
      lTmpMid = (Low + Hi) \ 2
   End If
  
   vTempVal = vData(lTmpMid)
  
   Do While (lTmpLow <= lTmpHi)
    
      Do While (vData(lTmpLow) < vTempVal And lTmpLow < Hi)
         lTmpLow = lTmpLow + 1
      Loop
    
      Do While (vTempVal < vData(lTmpHi) And lTmpHi > Low)
         lTmpHi = lTmpHi - 1
      Loop
    
      If (lTmpLow <= lTmpHi) Then
         vTmpHold = vData(lTmpLow)
         vData(lTmpLow) = vData(lTmpHi)
         vData(lTmpHi) = vTmpHold
         lTmpLow = lTmpLow + 1
         lTmpHi = lTmpHi - 1
      End If
    
   Loop
 
   If (Low < lTmpHi) Then
      QuickSortASC vData, Low, lTmpHi
   End If
 
   If (lTmpLow < Hi) Then
      QuickSortASC vData, lTmpLow, Hi
   End If
   QuickSortASC = True
  
   Exit Function
QuickSort:
   MsgBox "ÊäÈëÁË´íÎóµÄÊý¾Ý", vbExclamation, "´íÎó"
End Function

评论