Метод быстрой сортировки

intI = 1
    intCountCells = 0
    For intI = 1 To intCnt
        If Sheets(2).Cells(intI, 2).Value <> "" Then
            intCountCells = intCountCells + 1   
        End If
    Next intI
    intI = 0
    ReDim intArr(intCountCells)   
    For intI = 0 To intCountCells
        intArr(intI) = Sheets(2).Cells(intI + 1, 2).Value  
    Next intI

intI = 1
    intCountCells = 0
    For intI = 1 To intCnt
        If Sheets(2).Cells(intI, 2).Value <> "" Then
            intCountCells = intCountCells + 1   
        End If
    Next intI
    intI = 0
    ReDim intArr(intCountCells)   
    For intI = 0 To intCountCells
        intArr(intI) = Sheets(2).Cells(intI + 1, 2).Value  
    Next intI

Public Sub QSort(ByRef intArr() As Integer, ByVal low As Integer, ByVal high As Integer)
    Dim i As Integer, j As Integer
    Dim m, wsp As Double
    low = LBound(intArr)
    high = UBound(intArr)
    i = low
    j = high
    m = intArr((i + j) \ 2)
    Do While i < j
        Do While intArr(i) < m
            i = i + 1
        Loop
        Do While intArr(j) > m
            j = j - 1
        Loop
        If i <= j Then
            wsp = intArr(i)
            intArr(i) = intArr(j)
            intArr(j) = wsp
            i = i + 1
            j = j - 1
        End If
    Loop
    If low < j Then Call QSort(intArr, low, j)
    If i < high Then Call QSort(intArr, i, high)
    frmList.lstCells.List = intArr
End Sub

Sub QSort(intArr(), optional low As Integer, optional high As Integer)
  Dim m As long
  Dim wsp As integer, i As Integer, j As Integer
  i = low
  j = high
  m = intArr((i + j) \ 2)
  Do While (i <= j)
    Do While (intArr(i) < m And i < high)
      i = i + 1
    Loop
    Do While (m < intArr(j) And j > low)
      j = j - 1
    Loop
    If i < j Then
      wsp = intArr(i)
      intArr(i) = intArr(j)
      intArr(j) = wsp
    End If
    If i <= j Then
      i = i + 1
      j = j - 1
    End If
  Loop
  If low < j Then Call (QSort intArr, low, j)
  If i < high Then Call (QSort intArr, i, high)
End Sub

If low < j Then Call (QSort intArr, low, j)

If low < j Then Call QSort (intArr, low, j)

Private Sub cmdPrint_Click()
    frmList.lstCells.Clear
    Sheets(2).Columns("B:B").Value = ""
    Dim rngCell As Range, intI As Integer, intOtvet As Integer, intCnt As Integer, intCountCells As Integer
    intI = 1
    intCnt = Selection.Cells.count
    For Each rngCell In Selection
        Sheets(2).Cells(intI, 2) = rngCell.Value
        '        frmList.lstCells.AddItem rngCell.Value
        intI = intI + 1
    Next
    intI = 1
    intCountCells = 0
    For intI = 1 To intCnt
        If Sheets(2).Cells(intI, 2).Value <> "" Then
            intCountCells = intCountCells + 1    'Óçíàåì êîëè÷åñòâî ÿ÷ååê ñ äàííûìè
        End If
        If intCountCells = 0 Then
            MsgBox "Âûäåëèòå ÿ÷åéêè äëÿ çàïîëíåíèÿ!", vbCritical, "Îøèáêà"
            frmList.Hide
            GoTo EndS
        End If
    Next intI
    intI = 0
    ReDim intArr(intCountCells)    'Ìåíÿåì ðàçìåð ìàññèâà
    For intI = 0 To intCountCells
        intArr(intI) = Sheets(2).Cells(intI + 1, 2).Value  'Çàïîëíÿåì ìàññèâ äàííûìè èç ÿ÷ååê íà 2 ëèñòå
    Next intI
    ReDim Preserve intArr(intCountCells - 1)
 
    intOtvet = MsgBox("Íàæìèòå Äà äëÿ ïóçûðüêîâîé ñîðòèðîâêè." & Chr(10) & "Íàæìèòå Íåò äëÿ áûñòðîé ñîðòèðîâêè(ìåòîä Õîàðà)." & Chr(10) & "Íàæìèòå Îòìåíà äëÿ çàïèñè áåç ñîðòèðîâêè.", 3, "Âûáåðèòå òèï ñîðòèðîâêè")
    Select Case intOtvet
    Case 2
        frmList.lstCells.List = intArr()
        GoTo EndS
    Case 6
        
        Dim intP As Integer, intJ As Integer, intTmp As Integer
        For intP = 0 To intCountCells - 2
            For intJ = (intP + 1) To intCountCells - 1
                If intArr(intP) > intArr(intJ) Then
                    intTmp = intArr(intP)
                    intArr(intP) = intArr(intJ)
                    intArr(intJ) = intTmp
                End If
            Next intJ
        Next intP
        lstCells.List = intArr
        GoTo EndS
    Case 7
        Call QSort(intArr(), low, high)
        
    End Select
EndS:
End Sub

Sub QSort(ByRef intArr() As Integer, Optional low As Integer, Optional high As Integer)
     Dim IntIm As Integer, intJn As Integer
    Dim intM As Integer, intWsp As Integer
    low = LBound(intArr)
    high = UBound(intArr)
    IntIm = low
    intJn = high
    intM = intArr((IntIm + intJn) \ 2)
    Do While IntIm < intJn
        Do While intArr(IntIm) < intM
            IntIm = IntIm + 1
        Loop
        Do While intArr(intJn) > intM
            intJn = intJn - 1
        Loop
        If IntIm <= intJn Then
            intWsp = intArr(IntIm)
            intArr(IntIm) = intArr(intJn)
            intArr(intJn) = intWsp
            IntIm = IntIm + 1
            intJn = intJn - 1
        End If
    Loop
    low = IntIm
    high = intJn
    If low < intJn Then Call QSort(intArr, low, intJn)
    If IntIm > high Then Call QSort(intArr, IntIm, high)
    
    frmList.lstCells.List = intArr
End Sub

  m = intArr((low + high) \ 2)