Код программы:
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