Function next_RND_Long(ByVal ileftBound As Long, ByVal iRightBound As Long) As Long
  next_RND_Long = Fix((iRightBound - ileftBound) * Rnd) + ileftBound
End Function

Private Sub btnDoTest_Click()
 Dim dTime As Double

 dTime = MicroTimer

 Dim r As Range
 Dim ilastRow&
 
 [A1].Value = "Подождите несколько минут, будет сообщение о заврешении построения"
 
'получим последнюю строку заполненных данных
 ilastRow = Range("A:D").Find(What:="", After:=Range("A3"), LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Row - 1&
          
 'очистим область размещения результата
 If ilastRow > 3 Then
   Range("A4:D" & ilastRow).ClearContents
 End If
 Set r = [A4:D4]
 
 Test_shellsort r
 
 dTime = MicroTimer - dTime
 dTime = Round(dTime, 0)
 
 Dim nMinutes As Long, nSecs As Long
 nMinutes = dTime \ 60&
 nSecs = dTime - 60# * nMinutes
 '[A1].ClearContents
 [A1].Value = "Общее время работы - минут: " & nMinutes & " секунд: " & nSecs
 MsgBox "Построение завершено."
End Sub

Option Explicit

'Booby 2019

Public Function Ceiling(ByVal X As Double, Optional ByVal Factor As Double = 1) As Double
    Ceiling = (Int(X / Factor) - (X / Factor - Int(X / Factor) > 0)) * Factor
End Function

Sub randArray(pa() As Variant, ByVal pN As Long)
' формирует массив с числом элементов pN,
' и заполняет его случайными целыми
' в диапазоне от 0 до pN - 1

 ReDim pa(0 To pN - 1&)
 Dim i&
 For i = 0 To pN - 1&
   pa(i) = next_RND_Long(1, pN)
 Next
End Sub

Sub copyArray(ByRef pa() As Variant, ByRef pb() As Variant)
' копмрует целиком массив pa в массив pb
  pb = pa
End Sub

Function Less_V(ByRef a As Variant, ByRef B As Variant) As Boolean
  Less_V = (a < B)
End Function

Private Sub Swap_VS(ByRef pv_left As Variant, ByRef pv_right As Variant)
 ' обмен значений скалярных (простых) типов, переданных во входных параметрах по ссылке
  Dim v_Temp As Variant
  v_Temp = pv_right
  pv_right = pv_left
  pv_left = v_Temp
End Sub

Sub FindMinFirstMaxLastIndex(pa() As Variant, ByVal iLeft As Long, ByVal iRight As Long, ByRef iMin As Long, ByRef iMax As Long)
' процелура отыскивает методом линейного поиска индексы первого минимального и последнего максимального элементов
' в массиве pa() в позициях с iLeft (левая граница поиска) до iRight (правая граница поиска)
  Dim v_Min As Variant, v_Max As Variant
  Dim v_Temp As Variant
  Dim i As Long
  
  v_Min = pa(iLeft)
  iMin = iLeft
  v_Max = pa(iLeft)
  iMax = iLeft
  
  For i = iLeft + 1 To iRight
    v_Temp = pa(i)
    If v_Temp < v_Min Then
    'при сортировке по возрастанию левый элемент первый среди равных
      v_Min = pa(i)
      iMin = i
    End If
    
    If v_Temp >= v_Max Then
      'при сортировке по возрастанию ставим правый элемент последний среди равных
      v_Max = pa(i)
      iMax = i
    End If
  Next
  
End Sub

Sub FindMinFirstMaxLastIndex2(pa() As Variant, ByVal iLeft As Long, ByVal iRight As Long, ByRef iMin As Long, ByRef iMax As Long, ByRef bSorted As Boolean)
' процелура отыскивает методом линейного поиска индексы первого минимального и последнего максимального элементов
' в массиве pa() в позициях с iLeft (левая граница поиска) до iRight (правая граница поиска)
' дополнительно к FindMinFirstMaxLastIndex устанавливает флаг сортированности массива
' (Не используется в тесте)

  Dim v_Min As Variant, v_Max As Variant
  Dim v_Temp As Variant
  Dim i As Long
  
  bSorted = True
  
  v_Min = pa(iLeft)
  iMin = iLeft
  v_Max = pa(iLeft)
  iMax = iLeft
  
  For i = iLeft + 1 To iRight
    v_Temp = pa(i)
    If v_Temp < v_Min Then
    'при сортировке по возрастанию левый элемент первый среди равных
      v_Min = pa(i)
      iMin = i
      bSorted = False
    End If
    
    If v_Temp >= v_Max Then
      'при сортировке по возрастанию ставим правый элемент последний среди равных
      v_Max = pa(i)
      iMax = i
    End If
  Next
  
End Sub


Sub ShellSort_Shell(ByRef a() As Variant, ByVal iLeft As Long, ByVal iRight As Long)
'ваиант сортировки самого Шелла, с шагом h-сортировки, равным степеням двойки.
'не уходит от квадратичной зависимости.
'Приведен в исторических целях

Dim v As Variant
Dim i&, j&, h&
j = (iRight - iLeft) \ 4&
h = 1&
Do
  h = h + h
Loop While h <= j

Do While h > 0&
  For i = iLeft + h To iRight
    j = i
    v = a(i)
    Do While j >= iLeft + h
      If Less_V(v, a(j - h)) Then
        a(j) = a(j - h)
        j = j - h
      Else
        Exit Do
      End If
    Loop
    a(j) = v
  Next
  h = h \ 2&
Loop

End Sub

Sub ShellSort_Knuth(ByRef a() As Variant, ByVal iLeft As Long, ByVal iRight As Long)
' на основе исходных кодов Сэджвика https://www.cs.princeton.edu/~rs/shell/driver.c
' последовательность h-сортировок совпадает с последовательностью Пратта в англоязычной википедии, в которой нарастание идет до (iRight - iLeft) \ 3&
Dim v As Variant
Dim i&, j&, h&
j = (iRight - iLeft) \ 9&
h = 1&
Do
  h = 3 * h + 1
Loop While h <= j

Do While h > 0&
  For i = iLeft + h To iRight
    j = i
    v = a(i)
    Do While j >= iLeft + h
      If Less_V(v, a(j - h)) Then
        a(j) = a(j - h)
        j = j - h
      Else
        Exit Do
      End If
    Loop
    a(j) = v
  Next
  h = h \ 3&
Loop

End Sub

Sub ShellSort_Knuth_Sent(ByRef a() As Variant, ByVal iLeft As Long, ByVal iRight As Long)
' см. комментарий к ShellSort_Knuth
' отличия от ShellSort_Knuth:
' с целью исключения проверки j >= iLeft + h во внутреннем цикле жертвуется проход по массиву
' на котором выявляются позиции минимального и максимального элементов в массиве
' дополнительно к этому, проход на h=1 выделен в самостоятельный цикл.
Dim v As Variant
Dim i&, j&, h&
j = (iRight - iLeft) \ 9& '3& '9&
h = 1&
Do
  h = 3 * h + 1
Loop While h <= j

'поиск индексов минимального и максимального элементов
Dim iMinPos As Long, iMaxPos As Long
FindMinFirstMaxLastIndex a, iLeft, iRight, iMinPos, iMaxPos

If iLeft <> iMinPos Then
  'минимальный элемент в первую позицию
  Swap_VS a(iLeft), a(iMinPos)
End If

If iRight <> iMaxPos Then
  ' максимальный элемент в последнюю позицию
  Swap_VS a(iRight), a(iMaxPos)
End If

iRight = iRight - 1& ' правый элемент здесь на месте

Do While h > 1&
  For i = iLeft + h + 1 To iRight
    j = i
    v = a(i)
    Do
      If Less_V(v, a(j - h)) Then
        a(j) = a(j - h)
        j = j - h
      Else
        Exit Do
      End If
    Loop While j >= iLeft + h
    a(j) = v
  Next
  h = h \ 3&
Loop

' цикл для h = 1 выделяем в самостоятельный
' так как первый и последний элемент на своих местах, сдвигаем цикл на единицу
' в этой версии знаем, что первый (то есть нулевой) элемент точно на месте
For i = iLeft + 2 To iRight ' правый элемент здесь на месте
  j = i
  v = a(i)
  Do While Less_V(v, a(j - 1))
      a(j) = a(j - 1)
      j = j - 1
  Loop
  a(j) = v
Next
  
End Sub

Sub ShellSort_Knuth_Swapped(ByRef a() As Variant, ByVal iLeft As Long, ByVal iRight As Long)
' последовательность h-сортировок совпадает с последовательностью Пратта, в которой нарастание идет до (iRight - iLeft) \ 3&
'обменный вариант

Dim i&, j&, h&
j = (iRight - iLeft) \ 9&
h = 1&
Do
  h = 3 * h + 1
Loop While h <= j
'
Do While h > 0&
  For i = iLeft + h To iRight
    j = i
    Do While j >= iLeft + h
      If Less_V(a(j), a(j - h)) Then
        Swap_VS a(j - h), a(j)
        j = j - h
      Else
        Exit Do
      End If
    Loop
  Next
  h = h \ 3&
Loop

End Sub

Sub ShellSort_Gonnet(ByRef a() As Variant, ByVal iLeft As Long, ByVal iRight As Long)
' на основе исходных кодов Сэджвика https://www.cs.princeton.edu/~rs/shell/driver.c
' последовательность h-сортировок Gonnet 5/11
Dim v As Variant
Dim i&, j&, h&

h = iRight - iLeft + 1&
Do While h > 0&
    Do While h > 0&
      For i = iLeft + h To iRight
        j = i
        v = a(i)
        Do While j >= iLeft + h
          If Less_V(v, a(j - h)) Then
            a(j) = a(j - h)
            j = j - h
          Else
            Exit Do
          End If
        Loop
        a(j) = v
      Next
      h = h \ 3&
    Loop
  If h > 1& And h < 5& Then
    h = 1&
  Else
    h = (5 * h) \ 11
  End If
Loop
End Sub

Sub ShellSort_Sedg1(ByRef a() As Variant, ByVal iLeft As Long, ByVal iRight As Long)
' на основе исходных кодов Сэджвика https://www.cs.princeton.edu/~rs/shell/driver.c
' 1я последовательность Седжвика 1986г.   4^{k}+3*2^{k-1} + 1
Dim v As Variant
Dim i&, j&, h&, t&

t = 1&
While 4& * t * t < (iRight - iLeft)
  t = t + t
Wend
'
h = (iRight - iLeft) \ 4&
Do While t > 0&
      For i = iLeft + h To iRight
        j = i
        v = a(i)
        Do While j >= h
          If Less_V(v, a(j - h)) Then
            a(j) = a(j - h)
            j = j - h
          Else
            Exit Do
          End If
        Loop
        a(j) = v
      Next
  t = t \ 2&
  h = t * t - ((3& * t) \ 2) + 1&
Loop
End Sub

Sub ShellSort_Sedg1_Swapped(ByRef a() As Variant, ByVal iLeft As Long, ByVal iRight As Long)
' 1я последовательность Седжвика 1986г.   4^{k}+3*2^{k-1} + 1
' обменный вариант
'

Dim i&, j&, h&, t&

t = 1&
While 4& * t * t < (iRight - iLeft)
  t = t + t
Wend

h = (iRight - iLeft) \ 4&
Do While t > 0&
      For i = iLeft + h To iRight
        j = i
        Do While j >= h
          If Less_V(a(j), a(j - h)) Then
            Swap_VS a(j - h), a(j)
            j = j - h
          Else
            Exit Do
          End If
        Loop
      Next
  t = t \ 2&
  h = t * t - ((3& * t) \ 2) + 1&
Loop
End Sub

Sub ShellSort_Sedg1_Sent(ByRef a() As Variant, ByVal iLeft As Long, ByVal iRight As Long)
' 1я последовательность Седжвика 1986г.   4^{k}+3*2^{k-1} + 1
' оптимизации, аналогичные ShellSort_Knuth_Sent (см. комментарий)
' в данном случае они себя не оправдывают

Dim v As Variant
Dim i&, j&, h&, t&

'----------
t = 1&
While 4& * t * t < (iRight - iLeft)
  t = t + t
Wend

'поиск индексов минимального и максимального элементов
Dim iMinPos As Long, iMaxPos As Long ', bSorted As Boolean

FindMinFirstMaxLastIndex a, iLeft, iRight, iMinPos, iMaxPos ', bSorted
'FindMinFirstMaxLastIndex2 A, iLeft, iRight, iMinPos, iMaxPos, bSorted
'If bSorted Then
'   Exit Sub
'End If

If iLeft <> iMinPos Then
  'минимальный элемент в первую позицию
  Swap_VS a(iLeft), a(iMinPos)
End If

If iRight <> iMaxPos Then
  ' максимальный элемент в последнюю позицию
  Swap_VS a(iRight), a(iMaxPos)
End If

iRight = iRight - 1& ' правый элемент здесь на месте

h = (iRight + 1& - iLeft) \ 4&
Do While h > 1& And t > 0&
      For i = iLeft + h + 1 To iRight
        j = i
        v = a(i)
        Do While j >= h
          If Less_V(v, a(j - h)) Then
            a(j) = a(j - h)
            j = j - h
          Else
            Exit Do
          End If
        Loop
        a(j) = v
      Next

  t = t \ 2&
  h = t * t - ((3& * t) \ 2&) + 1&
Loop

' цикл для h = 1 выделяем в самостоятельный
' так как первый и последний элемент на своих местах, сдвигаем цикл на единицу
' в этой версии знаем, что первый (то есть нулевой) элемент точно на месте
For i = iLeft + 2 To iRight ' правый элемент здесь на месте
  j = i
  v = a(i)
  Do While Less_V(v, a(j - 1&))
      a(j) = a(j - 1&)
      j = j - 1&
  Loop
  a(j) = v
Next

End Sub

Sub ShellSort_Incerpi(ByRef a() As Variant, ByVal iLeft As Long, ByVal iRight As Long)
' на основе исходных кодов Сэджвика https://www.cs.princeton.edu/~rs/shell/driver.c
' последовательность h-сортировок совпадает с последовательностью A036569, Incerpi-Sedgewick-Knuth
Dim v As Variant
Dim i&, j&, h&, k&, t&
'-------------------
Static incs(0 To 15) As Long
If incs(0) = 0 Then
  incs(0) = 1391376
  incs(1) = 463792
  incs(2) = 198768
  incs(3) = 86961
  incs(4) = 33936
  incs(5) = 13776
  incs(6) = 4592
  incs(7) = 1968
  incs(8) = 861
  incs(9) = 336
  incs(10) = 112
  incs(11) = 48
  incs(12) = 21
  incs(13) = 7
  incs(14) = 3
  incs(15) = 1
End If

For k = 0 To 15
    h = incs(k)
    For i = iLeft + h To iRight
      j = i
      v = a(i)
      Do While j >= h
        If Less_V(v, a(j - h)) Then
          a(j) = a(j - h)
          j = j - h
        Else
          Exit Do
        End If
      Loop
      a(j) = v
    Next
Next
End Sub

'1, 4, 9, 20, 46, 103, 233, 525, 1182, 2660, 5985, 13467, 30301, 68178, 153401, 345152, 776591, 1747331, 3931496
Sub ShellSort_Tokuda(ByRef a() As Variant, ByVal iLeft As Long, ByVal iRight As Long)
' последовательность h-сортировок совпадает с последовательностью Tokuda A108870
Dim v As Variant
Dim i&, j&, h&, k&, t&

Static incs(0 To 18) As Long
If incs(0) = 0 Then
  incs(0) = 3931496
  incs(1) = 1747331
  incs(2) = 776591
  incs(3) = 345152
  incs(4) = 153401
  incs(5) = 68178
  incs(6) = 30301
  incs(7) = 13467
  incs(8) = 5985
  incs(9) = 2660
  incs(10) = 1182
  incs(11) = 525
  incs(12) = 233
  incs(13) = 103
  incs(14) = 46
  incs(15) = 20
  incs(16) = 9
  incs(17) = 4
  incs(18) = 1
End If

For k = 0 To 18
    h = incs(k)
    For i = iLeft + h To iRight
      j = i
      v = a(i)
      Do While j >= h
        If Less_V(v, a(j - h)) Then
          a(j) = a(j - h)
          j = j - h
        Else
          Exit Do
        End If
      Loop
      a(j) = v
    Next
Next

End Sub

'1, 4, 9, 20, 46, 103, 233, 525, 1182, 2660, 5985, 13467, 30301, 68178, 153401, 345152, 776591, 1747331, 3931496
Sub ShellSort_Tokuda_Swapped(ByRef a() As Variant, ByVal iLeft As Long, ByVal iRight As Long)
' последовательность h-сортировок совпадает с последовательностью Tokuda A108870
' обменный вариант

Dim v As Variant
Dim i&, j&, h&, k&, t&

Static incs(0 To 18) As Long
If incs(0) = 0 Then
  incs(0) = 3931496
  incs(1) = 1747331
  incs(2) = 776591
  incs(3) = 345152
  incs(4) = 153401
  incs(5) = 68178
  incs(6) = 30301
  incs(7) = 13467
  incs(8) = 5985
  incs(9) = 2660
  incs(10) = 1182
  incs(11) = 525
  incs(12) = 233
  incs(13) = 103
  incs(14) = 46
  incs(15) = 20
  incs(16) = 9
  incs(17) = 4
  incs(18) = 1
End If

For k = 0 To 18
    h = incs(k)
    For i = iLeft + h To iRight
      j = i
      Do While j >= h
        If Less_V(a(j), a(j - h)) Then
          Swap_VS a(j - h), a(j)
          j = j - h
        Else
          Exit Do
        End If
      Loop
    Next
Next

End Sub

Sub PrintResults(ByRef r As Range, ByVal vcName As String, ByVal nSize As Long, ByVal nTime1 As Double, ByVal nTime2 As Double)
'вывод результатов
  Static a(1 To 1, 1 To 4) As Variant
  If vcName <> "---------------------------------" Then
  a(1, 1) = vcName
  a(1, 2) = nSize
  a(1, 3) = nTime1
  a(1, 4) = nTime2
  Else
  a(1, 1) = vcName
  a(1, 2) = "-----"
  a(1, 3) = "-----"
  a(1, 4) = "-----"
  End If
  r.Value2 = a
  Set r = r.Offset(1, 0)
  
End Sub

Sub Test_shellsort(ByRef r As Range)
'тест производительности вариантов сортировки
  Dim a_sizes
  ' этот тест больше 16 минут
  a_sizes = Array(127, 323, 600, 1024, 2048, 4096, 8192, 12500, 25000, 50001, 66535, 88446, 128247, 189958, 269839, 539278, 728025, 1024& * 1024) ', 910031)
  
  ' около  3х минут
  'a_sizes = Array(127, 323, 600, 1024, 2048, 4096, 8192, 12500, 25000, 50001, 66535, 88446, 128247, 189958) ', 269839), 539278, 728025, 1024& * 1024) ', 910031)
  
  Dim dTime As Double
  Dim a_src() As Variant
  Dim a() As Variant
  Dim iSize&
  
  Dim s&
  
  For s = 0 To UBound(a_sizes)
  
  Randomize a_sizes(s)
  randArray a_src, a_sizes(s) 'iSize
    
  iSize = a_sizes(s)
  
  If iSize < 150000 Then
  'исходный вариант Шелла квдратичный по времени, поэтому показываем его не более чем до 150000 элементов
    copyArray a_src, a
    dTime = MicroTimer
    ShellSort_Shell a, 0, iSize - 1
    dTime = MicroTimer - dTime
    PrintResults r, "ShellSort_Shell", iSize, dTime, dTime * 1000000 / iSize
  End If
  
  copyArray a_src, a
  dTime = MicroTimer
  ShellSort_Knuth a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Knuth", iSize, dTime, dTime * 1000000 / iSize
    
  copyArray a_src, a
  dTime = MicroTimer
  ShellSort_Knuth_Sent a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Knuth_Sent", iSize, dTime, dTime * 1000000 / iSize
  
  copyArray a_src, a
  dTime = MicroTimer
  ShellSort_Knuth_Swapped a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Knuth_Swapped", iSize, dTime, dTime * 1000000 / iSize
  '
  copyArray a_src, a
  dTime = MicroTimer
  ShellSort_Sedg1_Swapped a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Sedg1_Swapped", iSize, dTime, dTime * 1000000 / iSize
  '
  copyArray a_src, a
  dTime = MicroTimer
  ShellSort_Sedg1 a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Sedge1", iSize, dTime, dTime * 1000000 / iSize
  '
  copyArray a_src, a
  dTime = MicroTimer
  ShellSort_Sedg1_Sent a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Sedge1_Sent", iSize, dTime, dTime * 1000000 / iSize
  '
  copyArray a_src, a
  dTime = MicroTimer
  ShellSort_Gonnet a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Gonnet", iSize, dTime, dTime * 1000000 / iSize
  '
  copyArray a_src, a
  dTime = MicroTimer
  ShellSort_Incerpi a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Incerpi", iSize, dTime, dTime * 1000000 / iSize
  '
  copyArray a_src, a
  dTime = MicroTimer
  ShellSort_Tokuda a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Tokuda", iSize, dTime, dTime * 1000000 / iSize
  '
  copyArray a_src, a
  dTime = MicroTimer
  ShellSort_Tokuda_Swapped a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Tokuda_Swapped", iSize, dTime, dTime * 1000000 / iSize
  '
  
  If iSize > 157 Then
  
  ' работа с почти сортированными массивами
  ' имитация работы с почти сортированным массивом (3 перестановки)
  If iSize > 37 Then
    Swap_VS a(23), a(37)
    If iSize > 157 Then
      Swap_VS a(123), a(157)
      If iSize > 500 Then
        Swap_VS a(323), a(477)
      End If
    End If
  End If
  dTime = MicroTimer
  ShellSort_Knuth a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Knuth почти сортирован", iSize, dTime, dTime * 1000000 / iSize
  
  ' имитация работы с почти сортированным массивом (3 перестановки)
  If iSize > 37 Then
    Swap_VS a(23), a(37)
    If iSize > 157 Then
      Swap_VS a(123), a(157)
      If iSize > 500 Then
        Swap_VS a(323), a(477)
      End If
    End If
  End If
  dTime = MicroTimer
  ShellSort_Knuth_Sent a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Knuth_Sent почти сортирован", iSize, dTime, dTime * 1000000 / iSize
    
  ' имитация работы с почти сортированным массивом (3 перестановки)
  If iSize > 37 Then
    Swap_VS a(23), a(37)
    If iSize > 157 Then
      Swap_VS a(123), a(157)
      If iSize > 500 Then
        Swap_VS a(323), a(477)
      End If
    End If
  End If
  dTime = MicroTimer
  ShellSort_Knuth_Swapped a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Knuth_Swapped почти сортирован", iSize, dTime, dTime * 1000000 / iSize
   
   ' имитация работы с почти сортированным массивом (3 перестановки)
  If iSize > 37 Then
    Swap_VS a(23), a(37)
    If iSize > 157 Then
      Swap_VS a(123), a(157)
      If iSize > 500 Then
        Swap_VS a(323), a(477)
      End If
    End If
  End If
  dTime = MicroTimer
  ShellSort_Sedg1_Swapped a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Sedg1_Swapped почти сортирован", iSize, dTime, dTime * 1000000 / iSize
   
   ' имитация работы с почти сортированным массивом (3 перестановки)
  If iSize > 37 Then
    Swap_VS a(23), a(37)
    If iSize > 157 Then
      Swap_VS a(123), a(157)
      If iSize > 500 Then
        Swap_VS a(323), a(477)
      End If
    End If
  End If
  dTime = MicroTimer
  ShellSort_Sedg1 a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Sedg1 почти сортирован", iSize, dTime, dTime * 1000000 / iSize
  
  ' имитация работы с почти сортированным массивом (3 перестановки)
  If iSize > 37 Then
    Swap_VS a(23), a(37)
    If iSize > 157 Then
      Swap_VS a(123), a(157)
      If iSize > 500 Then
        Swap_VS a(323), a(477)
      End If
    End If
  End If
  dTime = MicroTimer
  ShellSort_Tokuda a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Tokuda почти сортирован", iSize, dTime, dTime * 1000000 / iSize
  
  ' имитация работы с почти сортированным массивом (3 перестановки)
  If iSize > 37 Then
    Swap_VS a(23), a(37)
    If iSize > 157 Then
      Swap_VS a(123), a(157)
      If iSize > 500 Then
        Swap_VS a(323), a(477)
      End If
    End If
  End If
  dTime = MicroTimer
  ShellSort_Tokuda_Swapped a, 0, iSize - 1
  dTime = MicroTimer - dTime
  PrintResults r, "ShellSort_Tokuda_Swapped почти сортирован", iSize, dTime, dTime * 1000000 / iSize
  End If
  '-----------------------------------------------------------
  PrintResults r, "---------------------------------", 0, 0, 0

  Next
End Sub

Sub FindMinFirstMaxLastIndex_z32(pa() As Variant, ByVal iLeft As Long, ByVal iRight As Long, ByRef iMin As Long, ByRef iMax As Long)
' Booby, July 2019
' поиск индексов первого минимального и последнего максимального элементов
' в массиве pa() в позициях с iLeft (левая граница поиска) до iRight (правая граница поиска)
' алгоритм 3/2 сравнений, ( открыт в UC Santa Cruz в 70-е)
' исходный вариант кода не найден.
' выписывается по словесному комментарию к minmax_element c++ std library, реализованному на базе той же идеи

  Dim sTeps&
  sTeps = (iRight - iLeft) - 1&
  
  Dim v_Min As Variant, v_Max As Variant
  
  iMin = iLeft  
  iMax = iLeft + 1&

  If iMax <= iRight Then
    v_Min = pa(iMin)
    v_Max = pa(iMax)
    iLeft = iMax
  Else
    iMax = iMin
    Exit Sub
  End If
    
  If v_Max < v_Min Then
    Swap_VS v_Min, v_Max
    Swap_VS iMin, iMax
  End If
    
  Dim i&

  Dim hasLastStep&
  hasLastStep = (sTeps And 1&)
  'получаем четное число оставшихся пар
  sTeps = sTeps - hasLastStep
    
  Dim iNext&
  'при сортировке по возрастанию левый элемент первый среди равных
  'при сортировке по возрастанию ставим правый элемент последний среди равных
  'For i = 1& To sTeps Step 2&
  Do While iLeft < sTeps
    iLeft = iLeft + 1&
    iNext = iLeft + 1&
    
    If (pa(iLeft) < pa(iNext)) Then
      ' pa(iLeft) - потенциальный минимум
      If (pa(iLeft) < v_Min) Then
        v_Min = pa(iLeft)
        iMin = iLeft
      End If
      If Not (pa(iNext) < v_Max) Then
        v_Max = pa(iNext)
        iMax = iNext
      End If
    Else
      'pa(iNext) - потенциальный минимум
      If (pa(iNext) < v_Min) Then
        v_Min = pa(iNext)
        iMin = iNext
      End If
      If Not (pa(iLeft) < v_Max) Then
        v_Max = pa(iLeft)
        iMax = iLeft
      End If
    End If
    iLeft = iNext
  Loop
    
  'последний шаг
  If hasLastStep Then
    iLeft = iLeft + 1&
    If pa(iLeft) < v_Min Then
      v_Min = pa(iLeft)
      iMin = iLeft
    End If
    If Not (pa(iLeft) < v_Max) Then
      v_Max = pa(iLeft)
      iMax = iLeft
    End If
  End If
  
End Sub

Function next_RND_Long(ByVal ileftBound As Long, ByVal iRightBound As Long) As Long
  next_RND_Long = Fix((iRightBound - ileftBound) * Rnd) + ileftBound
End Function

Function next_RND_String(ByVal ileftBound As Long, ByVal iRightBound As Long) As String
  Dim iLen&, i&
  iLen = next_RND_Long(ileftBound, iRightBound)
  next_RND_String = String(iLen, vbNullChar)
  For i = 1 To iLen
    Mid$(next_RND_String, i, 1&) = Chr(next_RND_Long(33, 255)) '--1103))
  Next
  
End Function

Sub randArray_s(pa() As Variant, ByVal pN As Long)
' формирует массив с числом элементов pN,
' и заполняет его случайными элементами

 ReDim pa(0 To pN - 1&)
 Dim i&
 For i = 0 To pN - 1&
   pa(i) = next_RND_String(32, 128)
 Next
End Sub