Метод пузырьковой сортировки

Код программы:

Option Explicit

Private Sub Label1_Click()

End Sub

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() As Long)

' Сортировка массива с помощью алгоритма пузырьковой сортировки

' Работает с любым типом данных

Dim First As Integer, Last As Long

Dim i As Long, j As Long

Dim Temp

First = LBound(list)

Last = UBound(list)

For i = First To Last - 1

For j = i + 1 To Last

If list(i) > list(j) Then

Temp = list(j)

list(j) = list(i)

list(i) = Temp

End If

Next j

Next i

End Sub