Практическая работа 3 по предмету : алгоритмы и структура данных

Compiled Successfully. memory: 18048 time: 0.02 exit code: 0

Задание 8.
Рассчитать задачи, данные в программе EXCEL, используя язык
программирования VISUAL BASIC с использованием алгоритмов
сортировки BUBBLE, SHELL, QUICK. Это должно отражаться в
красивом дизайне со схемами и кнопками.




Option Explicit

Const n As Long = 15

Dim Chrt As ChartObject

Sub Init()

Set Chrt = ActiveSheet.ChartObjects(1)
End Sub

Sub RandomArray()

Dim coll As New Collection
Dim rndVal As Long
Randomize
Do While coll.count < n
rndVal = CLng((n - 1) * Rnd) + 1
On Error Resume Next
coll.Add rndVal, CStr(rndVal)
If Err.Number = 0 Then Cells(1, coll.count) = rndVal
Err.Clear
Loop
End Sub
Sub StopSorting()
End
End Sub
Sub BubbleSort()

Dim i As Long

Dim j As Long
Dim Flag As Boolean
Init
For i = 1 To n - 1
Flag = False
For j = 1 To n - i
If Cells(1, j) > Cells(1, j + 1) Then Swap Cells(1, j), Cells(1, j + 1): Flag = True
Next
If Not Flag Then Exit For
Next

End Sub

Sub InsertionSort()
Dim i As Long
Dim j As Long
Init
For i = 2 To n
j = i
Do While j > 1
If Cells(1, j) > Cells(1, j - 1) Then Exit Do
Swap Cells(1, j), Cells(1, j - 1)
j = j - 1
Loop
Next
End Sub
Sub StartMergeSort()
Init
MergeSort Range(Cells(1, 1), Cells(1, n))
End Sub

Function MergeSort(rng As Range)

Dim left As Range
Dim right As Range
Dim result As Range
Dim i As Long
Dim middle As Long
If rng.Cells.count = 1 Then
Set MergeSort = rng
Exit Function
Else
middle = CLng(rng.Cells.count / 2)

Set left = Range(rng.Columns(1), rng.Columns(middle))

Set right = Range(rng.Columns(middle + 1), rng.Columns(rng.Columns.count))
left = MergeSort(left)
right = MergeSort(right)

MergeSort = Merge(left, right)

End If
End Function

Function Merge(left As Range, right As Range) As Range

Dim i As Long
Dim count As Long
Dim result
Dim sizeLeft As Long
Dim sizeRight As Long
Dim FirstRng As Range
Set FirstRng = left.Cells(1, 1)
sizeLeft = left.count
sizeRight = right.count
ReDim result(1 To sizeLeft + sizeRight)
i = 1
Do While sizeLeft > 0 And sizeRight > 0
If left.Columns(1) <= right.Columns(1) Then
result(i) = left.Columns(1)
If sizeLeft > 1 Then Set left = left.Offset(, 1).Resize(, left.Columns.count - 1)
sizeLeft = sizeLeft - 1
Else
result(i) = right.Columns(1)
If sizeRight > 1 Then Set right = right.Offset(, 1).Resize(, right.Columns.count - 1)
sizeRight = sizeRight - 1
End If
i = i + 1
Loop
Do While sizeLeft > 0
result(i) = left.Columns(1)
If sizeLeft > 1 Then Set left = left.Offset(, 1).Resize(, left.Columns.count - 1)
sizeLeft = sizeLeft - 1
i = i + 1
Loop
Do While sizeRight > 0
result(i) = right.Columns(1)
If sizeRight > 1 Then Set right = right.Offset(, 1).Resize(, right.Columns.count - 1)
sizeRight = sizeRight - 1
i = i + 1
Loop

For i = 1 To UBound(result)

FirstRng.Offset(, i - 1) = result(i)
ChartRefresh
Next
Set Merge = FirstRng.Resize(, UBound(result))
End Function

Sub StartQuickSort()

Init
QuickSort Range(Cells(1, 1), Cells(1, n)), 1, n
End Sub

Sub QuickSort(rng As Range, lo, hi)

Dim p As Long
If lo < hi Then
p = Partition(rng, lo, hi)
Call QuickSort(rng, lo, p)
Call QuickSort(rng, p + 1, hi)
End If
End Sub

Function Partition(rng As Range, lo, hi)

Dim i As Long
Dim j As Long
Dim pivot
i = lo
j = hi
pivot = (rng.Cells(1, lo) + rng.Cells(1, hi)) / 2
Do
Do While rng.Cells(1, i) < pivot
i = i + 1
Loop
Do While rng.Cells(1, j) > pivot
j = j - 1
Loop
If i >= j Then
Partition = j
Exit Function
End If
Swap rng.Cells(1, i), rng.Cells(1, j)
Loop

End Function

Sub Swap(A As Range, B As Range)

Dim C As String
C = A
A = B
B = C
ChartRefresh
End Sub

Sub ChartRefresh()

Chrt.Activate
Application.Calculate
DoEvents
End Sub