Сортировка массива (Exel, метод прямого включения)

[esage]

нужно отсортировать массив в ecxel'e методом прямого включения
постоянно выдаёт ошибку на цикл, иногда работает, но редко
В чём дело не могу разобраться( Помогите пожалуйста!

Sub прямое_включение()
Dim a() As Integer, i As Integer, p As Integer, j As Integer
Rows(1).Delete
N = InputBox("Введите количество чисел в массиве")
ReDim a(1 To N)
Randomize
For i = 1 To N
a(i) = Rnd * 100
Next i
For i = 2 To N
p = a(i)
j = i
While (p < a(j - 1))
a(j) = a(j - 1)
j = j - 1
Wend
a(j) = p
Next i
For i = 1 To N
Cells(1, i) = a(i)
Next i
End Sub

[nilem]

попробуйте добавить еще одно условие

...
For i = 2 To n
    p = a(i)
    j = i
    Do While p < a(j - 1)
        a(j) = a(j - 1)
        j = j - 1: If j < 2 Then Exit Do
    Loop
    a(j) = p
Next i
...

[IgorGO]

у Вас J может принять значение 0
обьявите
ReDim a(N)
вместо
ReDim a(1 To N)

[esage]

спасибо большое, работает.

А можете еще помочь вот с чет: тоже сортировка массива, только шейкерная.

Вот код:

Sub шейкерная_сортировка()
Dim a() As Integer, i As Integer, N As Integer, j As Integer, k As Integer, x As Integer, d As Integer, s As String
Rows(1).Delete
N = InputBox("Введите количество чисел в массиве")
ReDim a(1 To N)
Randomize
For i = 1 To N
a(i) = Rnd * 100
Next i
d = 1
i = 0
For k = N - 1 To 1
i = i + d
For j = 1 To k
If (a(i) - a(i + d)) * d > 0 Then

x = a(i)
a(i) = a(i + d)
a(i + d) = x
End If
i = i + d
Next j
d = -d
Next k
s = ""
For i = 1 To N
s = s + " " + Str(a(i))
Next i
MsgBox (s)
End Sub

здесь выдаёт только первоначальный массив, а сортировать не хочет. В чем причина? ((

[doober]

Сообщение от esage

здесь выдаёт только первоначальный массив, а сортировать не хочет. В чем причина? ((

Ничего удивительного в этом нет.
У вас никогда не сработает условие,да и алгоритм не понятен.
Вот пример,перевел с С++,коменты родные оставил
Примеров в инете море.

Sub сортировка_перемешиванием()
    Dim a() As Integer, i As Integer, N As Integer, s As String
    Dim b As Integer
      
    Dim l_eft As Integer
    Rows(1).Delete
    N = InputBox("Введите количество чисел в массиве")
    ReDim a(N - 1)
    Randomize
    For i = 0 To N - 1
        a(i) = Rnd * 100
    Next i
    'Левая граница
    Dim r_ight As Integer
    r_ight = N - 1
    'Правая граница
  Do While l_eft < r_ight
        For i = l_eft To r_ight - 1
            'Слева направо...
            If a(i) > a(i + 1) Then
                b = a(i)
                a(i) = a(i + 1)
               a(i + 1) = b
                b = i
            End If
        Next
        r_ight = b
        'Сохраним последнюю перестановку как границу
        If l_eft >= r_ight Then
            Exit Do
        End If
        'Если границы сошлись выходим
        For i = r_ight To l_eft + 1 Step -1
            'Справа налево...
            If a(i - 1) > a(i) Then
                b = a(i)
                a(i) = a(i - 1)
                a(i - 1) = b
                b = i
            End If
        Next
            'Сохраним последнюю перестановку как границу
        l_eft = b
   Loop
   
      s = ""
    For i = 0 To N - 1
        s = s + " " + Str(a(i))
    Next i
    MsgBox (s)
   
End Sub

[NasyaNasya]

известен список студентов группы и количество пропущенных часов каждым из студентов. Напечатать в порядке возрастания тех,кто пропустил более 10 часов, используя метод сортировки прямыми включениями.

написали программу,но не можем додумать до конца(( помогите

Sub сортировка()
Dim A () as integer
Dim D () as integer
Dim i as integer
Dim j as integer
Dim n as integer

n=Val(InputBox("введите значение n"))
ReDim A(n)
ReDim B(n)
Randomize

For i = 1 To n
A(i) = Rnd*90
Cells (i,2).Value = A(i)
Next i

For i = 2 To n
A(0)=A(i)
j=j-1
do while A (0)<A(j)
A(j+1) = A(j)
j = j-1
loop
A(J+1)=A(0)
next i

for i = 1 to n
cells(i,3).value = a(i)next i

end sub