Упражнение по Bubble Sort Решение домашнего задания (Серия VBA 25)
содержание видео
Дата: 2021-09-02
Похожие видео
Комментарии и отзывы: 8
zn
Огромное спасибо за урок! я запарился и сделал авто нахождение массива в любом месте листа, но без графика:
Sub NW_bubbleSort)
Dim SortArray) As Variant
Dim sArray As Long
Dim eArray As Long
Dim i As Long
i = 0
Do Until i > 20
i = i + 1
If ActiveSheet. Cells(Rows. Count, i. End(xlUp. Row > 1 Then
eArray = ActiveSheet. Cells(Rows. Count, i. End(xlUp. Row
Exit Do
End If
Loop
sArray = ActiveSheet. Cells(eArray, Columns. Count. End(xlToLeft. Column - ActiveSheet. Cells(eArray, 1. End(xlToRight. Column + 1
MsgBox Row - & eArray & / Column - & sArray & i = & i
ReDim SortArray(1 To sArray)
For b = LBound(SortArray) To UBound(SortArray)
SortArray(b) = ActiveSheet. Cells(eArray, i - 1 + b)
Next b
MsgBox Join(SortArray, , )
Call bubbleSortFromList(SortArray, i, eArray)
End Sub
Sub bubbleSortFromList(list) As Variant, k As Long, m As Long)
Dim first As Long
Dim last As Long
Dim c As Long
Dim d As Long
Dim temp As Long
first = LBound(list)
last = UBound(list)
ActiveSheet. Range(Cells(m, k, Cells(m, k + last - 1. Select
Selection. Copy
ActiveSheet. Cells(m, k. Offset(-1, 0. Select
ActiveSheet. Paste
For c = first To last - 1
For d = c + 1 To last
If list(c) < list(d) Then
temp = list(d)
ActiveSheet. Cells(m, k. Offset(2, 3) = temp
list(d) = list(c)
list(c) = temp
ActiveSheet. Cells(m, k + c - 1) = list(c)
ActiveSheet. Cells(m, k + c - 1. Interior. Color = vbGreen
ActiveSheet. Cells(m, k + c) = list(d)
ActiveSheet. Cells(m, k + c. Interior. Color = vbRed
ActiveSheet. Cells(m, k + c - 2. Interior. Color = xlNone
End If
Next d
'MsgBox Cicle & c
Next c
ActiveSheet. Range(Cells(m, k, Cells(m, k + last - 1. Interior. Color = xlNone
MsgBox Join(list, , )
MsgBox!
ActiveSheet. Range(Cells(m, k, Cells(m, k + last - 1. Offset(-1, 0. Cut
ActiveSheet. Range(Cells(m, k, Cells(m, k + last - 1. Select
ActiveSheet. Paste
End Sub
ответить
Огромное спасибо за урок! я запарился и сделал авто нахождение массива в любом месте листа, но без графика:
Sub NW_bubbleSort)
Dim SortArray) As Variant
Dim sArray As Long
Dim eArray As Long
Dim i As Long
i = 0
Do Until i > 20
i = i + 1
If ActiveSheet. Cells(Rows. Count, i. End(xlUp. Row > 1 Then
eArray = ActiveSheet. Cells(Rows. Count, i. End(xlUp. Row
Exit Do
End If
Loop
sArray = ActiveSheet. Cells(eArray, Columns. Count. End(xlToLeft. Column - ActiveSheet. Cells(eArray, 1. End(xlToRight. Column + 1
MsgBox Row - & eArray & / Column - & sArray & i = & i
ReDim SortArray(1 To sArray)
For b = LBound(SortArray) To UBound(SortArray)
SortArray(b) = ActiveSheet. Cells(eArray, i - 1 + b)
Next b
MsgBox Join(SortArray, , )
Call bubbleSortFromList(SortArray, i, eArray)
End Sub
Sub bubbleSortFromList(list) As Variant, k As Long, m As Long)
Dim first As Long
Dim last As Long
Dim c As Long
Dim d As Long
Dim temp As Long
first = LBound(list)
last = UBound(list)
ActiveSheet. Range(Cells(m, k, Cells(m, k + last - 1. Select
Selection. Copy
ActiveSheet. Cells(m, k. Offset(-1, 0. Select
ActiveSheet. Paste
For c = first To last - 1
For d = c + 1 To last
If list(c) < list(d) Then
temp = list(d)
ActiveSheet. Cells(m, k. Offset(2, 3) = temp
list(d) = list(c)
list(c) = temp
ActiveSheet. Cells(m, k + c - 1) = list(c)
ActiveSheet. Cells(m, k + c - 1. Interior. Color = vbGreen
ActiveSheet. Cells(m, k + c) = list(d)
ActiveSheet. Cells(m, k + c. Interior. Color = vbRed
ActiveSheet. Cells(m, k + c - 2. Interior. Color = xlNone
End If
Next d
'MsgBox Cicle & c
Next c
ActiveSheet. Range(Cells(m, k, Cells(m, k + last - 1. Interior. Color = xlNone
MsgBox Join(list, , )
MsgBox!
ActiveSheet. Range(Cells(m, k, Cells(m, k + last - 1. Offset(-1, 0. Cut
ActiveSheet. Range(Cells(m, k, Cells(m, k + last - 1. Select
ActiveSheet. Paste
End Sub
ответить
Вячеслав
Очень крутые уроки! Все предельно просто и понятно с минимум воды! Большое спасибо!
Решение задания для сортировки значений выделенной области. Не знал как сделать ячейки после выделения снова бесцветными, поэтому пришлось закрасить всю область своим цветом:
'определение сортируемой области
Dim selectRange As Range
Set selectRange = Selection
Dim lboundRange As Long
Dim uboundRange As Long
lboundRange = 1
uboundRange = selectRange. Count
selectRange. Interior. Color = 15773696
'метод BubbleSort
Dim i As Long
Dim j As Long
Dim temp As Long
For i = lboundRange To uboundRange - 1
selectRange(i. Interior. Color = 255
For j = (i + 1) To uboundRange
selectRange(j. Interior. Color = 5287936
If selectRange(i) > selectRange(j) Then
temp = selectRange(j)
selectRange(j) = selectRange(i)
selectRange(i) = temp
End If
selectRange(j. Interior. Color = 15773696
Next j
selectRange(i. Interior. Color = 15773696
Next i
ответить
Очень крутые уроки! Все предельно просто и понятно с минимум воды! Большое спасибо!
Решение задания для сортировки значений выделенной области. Не знал как сделать ячейки после выделения снова бесцветными, поэтому пришлось закрасить всю область своим цветом:
'определение сортируемой области
Dim selectRange As Range
Set selectRange = Selection
Dim lboundRange As Long
Dim uboundRange As Long
lboundRange = 1
uboundRange = selectRange. Count
selectRange. Interior. Color = 15773696
'метод BubbleSort
Dim i As Long
Dim j As Long
Dim temp As Long
For i = lboundRange To uboundRange - 1
selectRange(i. Interior. Color = 255
For j = (i + 1) To uboundRange
selectRange(j. Interior. Color = 5287936
If selectRange(i) > selectRange(j) Then
temp = selectRange(j)
selectRange(j) = selectRange(i)
selectRange(i) = temp
End If
selectRange(j. Interior. Color = 15773696
Next j
selectRange(i. Interior. Color = 15773696
Next i
ответить
RUSn9
Здравствуйте, Билял. Благодарю за интересное домашнее задание. Сделал так: ):
Sub ColorArray)
Dim arr As Variant
arr = Лист1. Range(A1. CurrentRegion
last = UBound(arr, 2)
first = LBound(arr, 2)
Dim i As Integer
Dim j As Integer
Dim temp As Integer
Dim temp1 As Integer
For i = first To last - 1
Лист1. Cells(1, i. Interior. Color = 255
For j = i + 1 To last
Лист1. Cells(1, j. Interior. Color = 65535
If arr(1, i) > arr(1, j) Then
temp = arr(1, j)
temp1 = arr(1, i)
arr(1, j) = arr(1, i)
arr(1, i) = temp
Лист1. Cells(1, i. Value = temp
Лист1. Cells(1, j. Value = temp1
End If
Лист1. Cells(1, j. Interior. ColorIndex = xlNone
Next j
Лист1. Cells(1, i. Interior. ColorIndex = xlNone
Next i
MsgBox Три-четыре. Закончили упражнение!
End Sub
ответить
Здравствуйте, Билял. Благодарю за интересное домашнее задание. Сделал так: ):
Sub ColorArray)
Dim arr As Variant
arr = Лист1. Range(A1. CurrentRegion
last = UBound(arr, 2)
first = LBound(arr, 2)
Dim i As Integer
Dim j As Integer
Dim temp As Integer
Dim temp1 As Integer
For i = first To last - 1
Лист1. Cells(1, i. Interior. Color = 255
For j = i + 1 To last
Лист1. Cells(1, j. Interior. Color = 65535
If arr(1, i) > arr(1, j) Then
temp = arr(1, j)
temp1 = arr(1, i)
arr(1, j) = arr(1, i)
arr(1, i) = temp
Лист1. Cells(1, i. Value = temp
Лист1. Cells(1, j. Value = temp1
End If
Лист1. Cells(1, j. Interior. ColorIndex = xlNone
Next j
Лист1. Cells(1, i. Interior. ColorIndex = xlNone
Next i
MsgBox Три-четыре. Закончили упражнение!
End Sub
ответить
office
С удовольствием и внимательно смотрю Ваши уроки, за что спасибо огромное снова и снова! Замечу, что в каждом видео я почерпнул для себя идеи для реализации своих целей в разработке своих небольших программ, необходимых в моей основной работе. Например, одна из программ содержит около 23000 строк кода в общем: но с Вашей помощью я нашёл пути к оптимизации работы программы! Это и более широкое применение массивов и New Collection! СПАСИБО!
ответить
С удовольствием и внимательно смотрю Ваши уроки, за что спасибо огромное снова и снова! Замечу, что в каждом видео я почерпнул для себя идеи для реализации своих целей в разработке своих небольших программ, необходимых в моей основной работе. Например, одна из программ содержит около 23000 строк кода в общем: но с Вашей помощью я нашёл пути к оптимизации работы программы! Это и более широкое применение массивов и New Collection! СПАСИБО!
ответить
Андрей
Мега-мега-мегаграмотное изложение материала и продуктивные уроки! Редкость на просторах интернета! Низкий Вам поклон за столь эффективное изложение материала по VBA! Вы педагог от Бога, продолжайте в том же духе! Низкий поклон за труды! Не поленюсь и напишу это коммент по каждым видео курса!
ответить
Мега-мега-мегаграмотное изложение материала и продуктивные уроки! Редкость на просторах интернета! Низкий Вам поклон за столь эффективное изложение материала по VBA! Вы педагог от Бога, продолжайте в том же духе! Низкий поклон за труды! Не поленюсь и напишу это коммент по каждым видео курса!
ответить
Павел
Я использую для форматирования список, и делаю это так:
Sub QuickSort(Coll As Collection, first As Long, last As Long)
' Сортировка списка
Dim vCentreVal As Variant, vTemp As Variant
Dim lTempLow As Long
Dim lTempHi As Long
lTempLow = first
lTempHi = last
vCentreVal = Coll(first + last) \ 2)
Do While lTempLow first
lTempHi = lTempHi - 1
Loop
If lTempLow
ответить
Я использую для форматирования список, и делаю это так:
Sub QuickSort(Coll As Collection, first As Long, last As Long)
' Сортировка списка
Dim vCentreVal As Variant, vTemp As Variant
Dim lTempLow As Long
Dim lTempHi As Long
lTempLow = first
lTempHi = last
vCentreVal = Coll(first + last) \ 2)
Do While lTempLow first
lTempHi = lTempHi - 1
Loop
If lTempLow
ответить
Дмитрий
Билял, есть вопрос: мой Excel не видит из твоего файла. FullSeriesCollection - это связано с версией? У меня Excel 2007. Если все строки с этим словом закомментить, то алгоритм работает.
ответить
Билял, есть вопрос: мой Excel не видит из твоего файла. FullSeriesCollection - это связано с версией? У меня Excel 2007. Если все строки с этим словом закомментить, то алгоритм работает.
ответить
pavel
Отличная серия! Очень может пригодится, я бы точно, так не написал. По поводу, ваших планов на будущее, я прошу сделать уроки по графикам и диаграммам. Спасибо ХБ!
ответить
Отличная серия! Очень может пригодится, я бы точно, так не написал. По поводу, ваших планов на будущее, я прошу сделать уроки по графикам и диаграммам. Спасибо ХБ!
ответить
Добавить отзыв, комментарий
Другие видео канала
