Public Sub SortStringArray(ByRef vArr() As String, ByVal lngLeft As Long, ByVal lngRight As Long)
    Dim i As Long
    Dim j As Long
    Dim lngTestVal As Long
    Dim lngMid As Long

    'If lngLeft = dhcMissing Then lngLeft = LBound(varr)
    'If lngRight = dhcMissing Then lngRight = UBound(varr)
   
    If lngLeft < lngRight Then
        lngMid = (lngLeft + lngRight) \ 2
        lngTestVal = vArr(lngMid)
        i = lngLeft
        j = lngRight
        Do
            Do While (vArr(i) < lngTestVal)
                i = i + 1
            Loop
            Do While (vArr(j) > lngTestVal)
                j = j - 1
            Loop
            If i <= j Then
                SwapLongs vArr(i), vArr(j)
                i = i + 1
                j = j - 1
            End If
        Loop Until i > j
        ' To optimize the sort, always sort the
        ' smallest segment first.
        If j <= lngMid Then
            Call SortLongArray(vArr, lngLeft, j)
            Call SortLongArray(vArr, i, lngRight)
        Else
            Call SortLongArray(vArr, i, lngRight)
            Call SortLongArray(vArr, lngLeft, j)
        End If
    End If

End Sub

Call SortLongArray(vArr, i, lngRight)

Call SortStringArray(vArr, i, lngRight)

то реализовать её через собственный стек, но не рекурсией

SwapLongs vArr(i), vArr(j)

Sub SwapStrings(ByRef St1 As String, ByRef St2 As String)
Dim tmp As String
tmp = St1
St1 = St2
St2 = tmp
End Sub

Dim lngTestVal As Long

2GSerg, реализовывал QSort... рекурсией... ничего такого не заметил, работает шустро, стэк оверфлоу не вываливается... в чем причина твоей неприязни???

Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Type TimeExp
  Bubble As Long
  Exchange As Long
  Heap As Long
  Insertion As Long
  Quick As Long
  QuickNonRec As Long
  Shelll As Long
End Type

Private Sub Form_Load()
  Dim a As New Sorting, i As Long, MyArr(-800 To 4000), Reserve(-800 To 4000)
  Dim StartTime As Long
  Dim TotalRanks As TimeExp
  
  For i = LBound(MyArr) To UBound(MyArr)
    MyArr(i) = Rnd * 800
    Reserve(i) = MyArr(i)
  Next
  
  Randomize Timer
  StartTime = GetTickCount
  a.BubbleSort MyArr
  TotalRanks.Bubble = GetTickCount - StartTime
  SaveArr App.Path + "\Bubble.txt", MyArr()
  RestoreArr Reserve(), MyArr()
  
  StartTime = GetTickCount
  a.ExchangeSort MyArr
  TotalRanks.Exchange = GetTickCount - StartTime
  SaveArr App.Path + "\Exchange.txt", MyArr()
  RestoreArr Reserve(), MyArr()
  
  StartTime = GetTickCount
  a.HeapSort MyArr
  TotalRanks.Heap = GetTickCount - StartTime
  SaveArr App.Path + "\Heap.txt", MyArr()
  RestoreArr Reserve(), MyArr()
  
  StartTime = GetTickCount
  a.InsertionSort MyArr
  TotalRanks.Insertion = GetTickCount - StartTime
  SaveArr App.Path + "\Insertion.txt", MyArr()
  RestoreArr Reserve(), MyArr()
  
  StartTime = GetTickCount
  a.QuickSort MyArr, LBound(MyArr), UBound(MyArr)
  TotalRanks.Quick = GetTickCount - StartTime
  SaveArr App.Path + "\Quick.txt", MyArr()
  RestoreArr Reserve(), MyArr()
  
  StartTime = GetTickCount
  a.QuickSortNonRecursive MyArr
  TotalRanks.QuickNonRec = GetTickCount - StartTime
  SaveArr App.Path + "\Quick.txt", MyArr()
  RestoreArr Reserve(), MyArr()
  
  StartTime = GetTickCount
  a.ShellSort MyArr
  TotalRanks.Shelll = GetTickCount - StartTime
  SaveArr App.Path + "\Shell.txt", MyArr()
  
  MsgBox "Ага! Вот результаты:" & vbNewLine & vbNewLine & "Пузырёк    " & TotalRanks.Bubble & vbNewLine & _
                                                          "Обмен      " & TotalRanks.Exchange & vbNewLine & _
                                                          "Куча       " & TotalRanks.Heap & vbNewLine & _
                                                          "Вставка    " & TotalRanks.Insertion & vbNewLine & _
                                                          "Быстрая    " & TotalRanks.Quick & vbNewLine & _
                                                          "Быстрая нерекурсивная " & TotalRanks.QuickNonRec & vbNewLine & _
                                                          "Shell      " & TotalRanks.Shelll & vbNewLine

End Sub

Private Sub RestoreArr(From(), Where())
  Dim i As Long
  For i = LBound(From) To UBound(From)
    Where(i) = From(i)
  Next
End Sub

Private Sub SaveArr(FName As String, Arr())
  Dim i As Long
  Open FName For Output As #1
  For i = LBound(Arr) To UBound(Arr)
    Write #1, Arr(i)
  Next
  Close #1
End Sub

Option Explicit

Private Type QuickStack
  Low As Long
  High As Long
End Type



Private Sub Swap(a As Variant, b As Variant)
  Dim tmp As Variant
  tmp = a: a = b: b = tmp
End Sub

Private Function RandInt(Lower As Long, Upper As Long) As Long
  'Возвращает случайное целое в промежутке от Lower до Upper включительно.
  RandInt = Int(Rnd * (Upper - Lower + 1)) + Lower
End Function

' ================================ Пузырёк ===================================
'    Сортировка пузырьком проходит по SortArray, сравнивает два соседних
'    элемента и меняет их местами, чтобы был правильный порядок.  Это
'    продолжается, пока все пары не будут на местах.
' ============================================================================

Public Sub BubbleSort(SortArray())
  Dim i As Long, Switch As Long, Limit As Long
  
  Limit = UBound(SortArray)
  Do
    Switch = LBound(SortArray)
    For i = LBound(SortArray) To Limit - 1
      If SortArray(i) > SortArray(i + 1) Then Swap SortArray(i), SortArray(i + 1): Switch = i
    Next
    Limit = Switch
  Loop While Switch > LBound(SortArray)
End Sub

' ================================= Обмен ====================================
'   Сортировка обменом сравнивает каждый элемент в SortArray, начиная с
'   первого, с каждым последующим элементом.  Если следующий элемент меньше
'   текущего, он обменивается с текущим, и процесс повторяется для следующего
'   элемента
' ============================================================================

Public Sub ExchangeSort(SortArray())
  Dim i As Long, SmallestRow As Long, j As Long
  
  For i = LBound(SortArray) To UBound(SortArray)
    SmallestRow = i
    For j = i + 1 To UBound(SortArray)
      If SortArray(j) < SortArray(SmallestRow) Then SmallestRow = j
    Next
    ' Нашли значение меньше текущего, меняем их
    If SmallestRow > i Then Swap SortArray(i), SortArray(SmallestRow)
  Next
End Sub

' =============================== HeapSort ===================================
'  HeapSort работает, вызывая две другие процедуры - PercolateUp и PercolateDown.
'  PercolateUp превращает SortArray в "кучу" (heap), которая обладает свойствами,
'  представленными на схеме:
'
'                               SortArray(1)
'                               /          \
'                    SortArray(2)           SortArray(3)
'                   /          \            /          \
'         SortArray(4)   SortArray(5)   SortArray(6)  SortArray(7)
'          /      \       /       \       /      \      /      \
'        ...      ...   ...       ...   ...      ...  ...      ...
'
'
'  Здесь каждый "родительский узел" больше каждого из "дочерних узлов";
'  например, SortArray(1) больше SortArray(2) и SortArray(3),
'  SortArray(3) больше SortArray(6) и SortArray(7), и так далее.
'
'  Таким образом, когда первый цикл FOR...NEXT завершится, наибольший элемент
'  будет в SortArray(1).
'
'  Второй цикл FOR...NEXT меняет местами значение в SortArray(1) и в
'  Ubound(), восстанавливает кучу (с помощью PercolateDown) для всех
'  Ubound() - 1, затем меняет местами элемент в SortArray(1) и элемент в
'  Ubound() - 1, восстанавливает кучу для Ubound() - 2, и продолжает таким
'  образом, пока массив не будет отсортирован.
' ============================================================================

Public Sub HeapSort(SortArray())
  Dim i As Long
  
  For i = LBound(SortArray) + 1 To UBound(SortArray)
    PercolateUp SortArray(), i
  Next
  
  For i = UBound(SortArray) To LBound(SortArray) + 1 Step -1
    Swap SortArray(LBound(SortArray)), SortArray(i)
    PercolateDown SortArray(), i - 1
  Next
End Sub

Private Sub PercolateDown(SortArr(), MaxLevel As Long)
  ' Имеем в виду следующую фишку
  ' Допустим, у нас нижняя граница массива отрицательная, а верхняя положительная,
  ' то есть SortArray(-5 To 15), к примеру.
  ' Тогда мы будем иметь всякий гон в номерах дочерних нодов
  ' Поэтому придётся ввести FakeIndex = RealIndex - LBound(SortArr) + 1
  ' Помним также, что MaxLevel передаётся ещё в неприведённом виде
  Dim i As Long, Child As Long
  
  i = 1
  
  ' Двигаем значение SortArray(1) вниз по куче, пока не дойдём до нужного узла
  ' (то есть, пока оно меньше значения родительского узла или мы достигнем
  ' MaxLevel, низа текущей кучи):
  Do
    Child = 2 * i             ' индекс дочернего узла.
    ' Достигли низа кучи, выходим:
    If Child > MaxLevel - LBound(SortArr) + 1 Then Exit Do
    ' Если два дочерних нода, находим наибольший:
    If Child + 1 <= MaxLevel - LBound(SortArr) + 1 Then
      If SortArr(Child + 1 + LBound(SortArr) - 1) > SortArr(Child + LBound(SortArr) - 1) Then Child = Child + 1
    End If
    
    ' Двигаем значение вниз, пока оно не больше любого дочернего узла
    If SortArr(i + LBound(SortArr) - 1) < SortArr(Child + LBound(SortArr) - 1) Then
      Swap SortArr(i + LBound(SortArr) - 1), SortArr(Child + LBound(SortArr) - 1)
      i = Child
    ' Иначе, SortArr был восстановлен в кучу от 1 до MaxLevel, так что выходим
    Else
      Exit Do
    End If
  Loop
End Sub

Private Sub PercolateUp(SortArr(), MaxLevel As Long)
  ' Имеем в виду ту же фишку, что и в PercolateDown
  Dim i As Long, Parent As Long
  i = MaxLevel - LBound(SortArr) + 1
  
  Do Until i = 1
    Parent = i \ 2            ' Индекс родителя.
    If SortArr(i + LBound(SortArr) - 1) > SortArr(Parent + LBound(SortArr) - 1) Then
      Swap SortArr(Parent + LBound(SortArr) - 1), SortArr(i + LBound(SortArr) - 1)
      i = Parent
    Else
      Exit Do
    End If
  Loop
End Sub

' ================================ Вставка ===================================
'   Сортировка вставкой сравнивает величину каждого последующего элемента
'   в SortArray с величинами всех предыдущих элементов. Когда процедура
'   находит правильное место для нового элемента, она вставляет его в это
'   место, и перемещает все остальные элементы вниз на одну позицию.
' ============================================================================

Public Sub InsertionSort(SortArray())
  Dim TempVal As Variant, i As Long, j As Long
  
  For i = LBound(SortArray) + 1 To UBound(SortArray)
    TempVal = SortArray(i)
    
    For j = i To LBound(SortArray) + 1 Step -1
      
      ' До тех пор, пока величина (j-1)-го элемента больше, чем величина
      ' оригинального элемента в SortArray(i), продолжаем сдвигать
      ' элементы массива вниз:
      If SortArray(j - 1) > TempVal Then
        SortArray(j) = SortArray(j - 1)
      ' Иначе выходим из цикла FOR...NEXT:
      Else
        Exit For
      End If
    Next
    
    ' Вставляем исходное значение SortArray(i) в SortArray(j):
    SortArray(j) = TempVal
  Next
End Sub

' ========================== Быстрая сортировка ==============================
'   Быстрая сортировка работает путём выбора случайного "центрального"
'   элемента в SortArray, затем она перемещает каждый элемент, который больше
'   "центрального", по одну сторону от него, а все, которые меньше - по другую.
'   После этого она рекурсивно вызывается для каждого из двух "кусков", созданных
'   таким раскидыванием. Когда число элементов в куске достигает двух, рекурсия
'   прекращается, а массив становится отсортированным.
' ============================================================================

Public Sub QuickSort(SortArray(), Low As Long, High As Long)
  Dim RandIndex As Long, Partition As Variant
  Dim i As Long, j As Long
  
  If Low < High Then
    If Abs(High - Low) = 1 Then 'Abs заюзан опять-таки из-за возможности отриц. индексов
      ' Если у нас два элемента в куске, то правильно их расставляем
      ' и прекращаем рекурсию:
      If SortArray(Low) > SortArray(High) Then Swap SortArray(Low), SortArray(High)
    Else 'Нет, больше двух элементов в куске!
      ' Выбираем случайный элемент, двигаем его в конец:
      RandIndex = RandInt(Low, High)
      Swap SortArray(High), SortArray(RandIndex)
      Partition = SortArray(High)
      Do
        ' Идём с обоих сторон по направлению к "центральному":
        i = Low: j = High
        Do While (i < j) And (SortArray(i) <= Partition)
          i = i + 1
        Loop
        Do While (j > i) And (SortArray(j) >= Partition)
          j = j - 1
        Loop
        ' Если мы не достигли "центрального", это значит, что два
        ' элемента любой стороне в неправильном порядке, меняем их:
        If i < j Then Swap SortArray(i), SortArray(j)
      Loop While i < j

      ' Двигаем центральный обратно на его место в массиве:
      Swap SortArray(i), SortArray(High)
      
      ' Рекурсивно вызываемся (передаём сначала меньший кусок, чтобы занять
      ' меньше стекового пространства):
      If (i - Low) < (High - i) Then
        QuickSort SortArray(), Low, i - 1
        QuickSort SortArray(), i + 1, High
      Else
        QuickSort SortArray(), i + 1, High
        QuickSort SortArray(), Low, i - 1
      End If
    End If
  End If
End Sub


' =============================== ShellSort ==================================
'  ShellSort похожа на Пузырьковую сортировку. Однако она начинается
'  сравнением элементов, которые достаточно далеко (между ними находится
'  Offset других значений, Offset первоначально равен половине размера
'  массива), затем сравнивает элементы, которые расположены близко
'  когда Offset равен 1, последняя итерация этой процедуры есть простая
'  сортировка пузырьком).
' ============================================================================

Public Sub ShellSort(SortArray())
  Dim Offset As Long, Limit As Long, Switch As Long, i As Long
  
  ' Устанавливаем Offset равным половине размера массива:
  Offset = (UBound(SortArray) - LBound(SortArray) + 1) \ 2
  
  Do While Offset > 0          ' Петляем, пока Offset не будет равен 0.
    Limit = UBound(SortArray) - Offset
    Do
      Switch = LBound(SortArray) - 1 ' Сигнал того, что ничего не меняли.
      ' Сравниваем элементы и ставим их правильно:
      For i = LBound(SortArray) To Limit
        If SortArray(i) > SortArray(i + Offset) Then
          Swap SortArray(i), SortArray(i + Offset)
          Switch = i
        End If
      Next
      
      ' На следующем проходе сортируем только до места последней замены:
      Limit = Switch - Offset
    Loop While Switch >= LBound(SortArray)

    ' Замен не было, уменьшим Offset вдвое:
    Offset = Offset \ 2
  Loop
End Sub




Public Sub QuickSortNonRecursive(SortArray())
  Dim i As Long, j As Long, lb As Long, ub As Long
  Dim stack() As QuickStack, stackpos As Long, ppos As Long, pivot As Variant
  
  ReDim stack(1 To 1024)
  stackpos = 1

  stack(1).Low = LBound(SortArray)
  stack(1).High = UBound(SortArray)
  
  Do
    'Взять границы lb и ub текущего массива из стека.
    lb = stack(stackpos).Low
    ub = stack(stackpos).High
    stackpos = stackpos - 1
    
    Do
      'Шаг 1. Разделение по элементу pivot
      ppos = (lb + ub) \ 2
      i = lb: j = ub: pivot = SortArray(ppos)
      
      Do
        Do While SortArray(i) < pivot: i = i + 1: Loop
        Do While pivot < SortArray(j): j = j - 1: Loop
        
        If i <= j Then
          Swap SortArray(i), SortArray(j)
          i = i + 1
          j = j - 1
        End If
      Loop While i <= j
      
      'Сейчас указатель i указывает на начало правого подмассива,
      'j - на конец левого lb ? j ? i ? ub.
      'Возможен случай, когда указатель i или j выходит за границу массива
      
      'Шаги 2, 3. Отправляем большую часть в стек  и двигаем lb,ub
      
      If i < ppos Then   'правая часть больше
        If i < ub Then
          stackpos = stackpos + 1
          stack(stackpos).Low = i
          stack(stackpos).High = ub
        End If
        ub = j          'следующая итерация разделения будет работать с левой частью
      Else
        If j > lb Then
          stackpos = stackpos + 1
          stack(stackpos).Low = lb
          stack(stackpos).High = j
        End If
        lb = i
      End If
    Loop While lb < ub
  Loop While stackpos
End Sub