Простыми включениями
| Sub Включение() ThisWorkbook.Sheets(1).UsedRange.Delete Cells(1, 6) = "Сортировка элементов массива простыми включениями" Cells(2, 1) = "Отсортированная последовательность" Cells(2, 10) = "Сортируемая последовательность" Cells(3, 1) = "Шаги" Cells(3, 2) = "k" Cells(3, 8) = "i" Cells(3, 15) = "h" Cells(10, 1) = "Определение позиции очередного элемента последовательности2 в последовательности1" Cells(11, 1) = "k" Cells(11, 7) = "h" Cells(11, 8) = "j=i-1" Cells(20, 1) = "Сдвиг на одну позицию вправо с k элемента до i" Cells(21, 1) = "k" Cells(25, 1) = "Постановка элемента h=a[i] на k место" Cells(26, 1) = "k" Cells(26, 7) = "h" For i = 1 To 5 Cells(3, 2 + i) = "a[" & i & "]" Cells(3, 9 + i) = "a[" & i & "]" Cells(11, i + 1) = "a[" & i & "]" Cells(21, i + 1) = "a[" & i & "]" Cells(26, i + 1) = "a[" & i & "]" Next For i = 10 To 14 Cells(4, i) = InputBox("Введите a[" & i - 9 & "]", , , 7000, 7000) Next i = 1 Cells(4 + i, 1) = i Cells(4 + i, 8) = i Cells(4 + i, 3) = Cells(3 + i, 10) Cells(i + 4, 3).Interior.Color = 5296274 For q = 1 To 5 Cells(12, q + 1) = Cells(4, q + 1) Cells(22, q + 1) = Cells(4, q + 1) Cells(27, q + 1) = Cells(4, q + 1) Next For i = 2 To 5 MsgBox ("Рассматриваем следующий элемент") Rows(2 + i).Interior.Pattern = xlNone For q = i To 5 Cells(i + 3, q + 9) = Cells(i + 2, q + 9) Cells(i + 3, q + 9).Interior.Color = 5296274 Cells(i + 3, 15).Interior.Color = xlNone Next q Cells(i + 4, 15) = Cells(i + 3, i + 9) Cells(i + 4, 15).Interior.Color = 5296274 Cells(4 + i, 1) = i Cells(4 + i, 8) = i Место (i) Сдвиг (i) Постановка (i) For q = 1 To i Cells(i + 4, q + 2) = Cells(27, q + 1) Cells(i + 4, q + 2).Interior.Color = 5296274 Next Rows(2 + i).Interior.Pattern = xlNone Next Rows(2 + i).Interior.Pattern = xlNone MsgBox ("СОРТИРОВКА ОКОНЧЕНА") End Sub | Sub Место(i) Dim z As Integer Range("A13:H17").Delete (1): z = 13 Cells(z, 1) = 1: Cells(z, 8) = i - 1 For q = 1 To i Cells(12, q + 1) = Cells(i + 3, q + 2) Next While Cells(z, 1)=1 And Cells(z, 8)>=1 Cells(i+3, 2).Interior.Color = xlNone MsgBox ("Ищем место элемента h=a[" & i & "]=" & Cells(i + 4, 15)) Rows("10:30").Interior.Pattern=xlNone Cells(z, 7) = Cells(i + 4, 15) Cells(z, 7).Interior.Color = 65535 Cells(z, 2) = Cells(z, 7) Cells(z, 2).Interior.Color = 65535 Cells(z, 3) = ">" Cells(z, 3).Interior.Color = 65535 Cells(z, 4) = Cells(12, Cells(z, 8) + 1) Cells(z, 4).Interior.Color = 65535 If Cells(z, 2) <= Cells(z, 4) Then Cells(z, 5) = "нет" Cells(z, 5).Interior.Color = 65535 z = z + 1 If Cells(z - 1, 8) - 1 > 0 Then Cells(z, 1) = Cells(z - 1, 1) Cells(z, 1).Interior.Color=65535 Cells(z, 8) = Cells(z - 1, 8) - 1 Cells(z, 8).Interior.Color=65535 Else MsgBox ("Нашли место элемента") Cells(i + 4, 2) = Cells(z - 1, 1) Cells(i + 4, 2).Interior.Color = 65535 End If Else Cells(z, 5) = "да" Cells(z, 5).Interior.Color = 65535 Cells(z, 1) = Cells(z, 8) + 1 Cells(z, 1).Interior.Color = 65535 MsgBox ("Нашли место элемента") Cells(i + 4, 2) = Cells(z, 1) Cells(i + 4, 2).Interior.Color = 65535 End If Wend End Sub Sub Сдвиг(i) Rows("10:30").Interior.Pattern=xlNone Cells(22, 1) = Cells(i + 4, 2) For q = 1 To i Cells(22, q + 1) = Cells(i + 3, q + 2) Cells(22,q+1).Interior.Color = 65535 Next MsgBox ("Сдвигаем элементы") For q = i To Cells(22, 1) + 1 Step -1 Cells(22, q + 1) = Cells(22, q) Cells(22,q+1).Interior.Color = 65535 Next MsgBox ("Сдвинули элементы") End Sub Sub Постановка(i) Rows("10:30").Interior.Pattern=xlNone Cells(27, 1) = Cells(22, 1) Cells(27, 7) = Cells(4 + i, 15) Cells(27, 1).Interior.Color = 65535 Cells(27, 7).Interior.Color = 65535 For q = 1 To i Cells(27, q + 1) = Cells(22, q + 1) Cells(27,q+1).Interior.Color = 65535 Next q MsgBox ("Вставляем элемент") Cells(27,Cells(27, 1) + 1) = Cells(27, 7) Cells(27, Cells(27, 1) + 1).Interior.Color = 65535 MsgBox ("Вставили элемент") End Sub |
| Процедура, демонстрирующая сущность сортировки элементов массива простыми включениями |
Дата добавления: 2015-01-26; просмотров: 752;