4. Метод пересчета Код программы:

Option Explicit

Private Sub lblTime1_Click()

End Sub

Private Sub lblTime2_Click()

End Sub

Private Sub OKButton_Click()

Dim Array1() As Long, Array2() As Long

Dim i As Long

Dim Elements As Long, RElement As Long, Temp As Long

Dim Time1 As Date, Time2 As Date

Dim Msg As String

Dim r As Long

lblTime1.Caption = ""

' Проверка вводиых в форму данных

If Not IsNumeric(tbElements.Value) Then

MsgBox "Некорректные данные (нет элементов)", vbInformation

tbElements.SetFocus

Exit Sub

End If

Elements = Val(tbElements.Value)

If Elements < 1 Then

MsgBox "Некорректные данные (Нет элементов)", vbInformation

tbElements.SetFocus

Exit Sub

End If

' Формирование четырех идентичных массивов

lblCurrentSort = "Создание массива..."

Me.Repaint

Randomize

ReDim Array1(1 To Elements, 0)

ReDim Array2(1 To Elements)

For i = 1 To Elements

Array1(i, 0) = CLng(Rnd * 100000)

Array2(i) = Array1(i, 0)

Next i

' Сортировка методом пересчета

If CheckBox1 Then

lblCurrentSort = "Сортировка методом пересчета..."

Me.Repaint

Time1 = Timer

Call MetodSort(Array2)

Time2 = Timer

lblTime1.Caption = Format(Time2 - Time1, "00.00") & " сек."

Me.Repaint

End If

' Сохранение отсортированных данных

Worksheets("Данные").Activate

Cells.Clear

On Error Resume Next

Range(Cells(1, 1), Cells(1, 2)) = Array("Исходный", "Сортирован")

Range(Cells(2, 1), Cells(UBound(Array1) + 1, 1)) = Array1

Range(Cells(2, 2), Cells(UBound(Array2) + 1, 2)) = Application.Transpose(Array2)

'If Err.Value <> 0 Then Cells(2, 1) = "Слишком много данных"

lblCurrentSort = "Завершено."

End Sub

Private Sub CancelButton_Click()

Unload Me

End Sub

Код подпрограммы, реализующей метод:

Option Explicit

Sub MetodSort(list)

Dim counts()

Dim i As Long

Dim j As Long

Dim next_index As Long

Dim min, max

Dim min_value As Variant, max_value As Variant

' Создание массива счетчиков. VBA автоматически инициализирует все записи 0.

min_value = Minimum(list)

max_value = Maximum(list)

min = LBound(list)

max = UBound(list)

ReDim counts(min_value To max_value)

' Подсчет значений.

For i = min To max

counts(list(i)) = counts(list(i)) + 1

Next i

' Запись значений обратно в массив списка.

next_index = min

For i = min_value To max_value

For j = 1 To counts(i)

list(next_index) = i

next_index = next_index + 1

Next j

Next i

End Sub

Function Minimum(list)

Dim i As Long

Minimum = list(LBound(list))

For i = LBound(list) To UBound(list)

If list(i) < Minimum Then Minimum = list(i)

Next i

End Function

Function Maximum(list)

Dim i As Long

Maximum = list(LBound(list))

For i = LBound(list) To UBound(list)

If list(i) > Maximum Then Maximum = list(i)

Next i

End Function

Технология выполнения работы

1. Разработать алгоритм для написания программы в виде блок-схемы.

2. Написать программу.

3. Протестировать ее с разными исходными данными.

Содержание отчета

1. Цель работы, условие задачи

2. Алгоритм в виде блок-схемы.

3. Исходный текст программы.

4. Вводимые данные и результаты.

5. Фрагменты экрана с диалоговыми окнами Excel.

6. Результат работы программы должен иметь наглядный вид.

Вопросы для защиты работы

1. Как описываются массивы переменных?

2. Как выглядит оператор цикла FOR?

3. В чем смысл сортировки?

4. Какая сортировка наиболее быстрая?

5. Как создавать формы?

6. Какие процедуры вы знаете?

7. Чем отличается процедура от функции?

8. Как задать значения массива через датчик случайных чисел?