Option Explicit
Dim lastColumn As Long
Dim firstColumn As Long
Dim rangeOfValues As range
Dim i As Long
Dim j As Long
Dim temp As Long
Dim valuesArray() As Long
Dim cellChecked As range
Dim counter As Integer
Sub mainProcedure()
Call Module4.IdentificationRangeOfValues(rangeOfValues, firstColumn, lastColumn)
Call Module4.AuxBubbleSort(rangeOfValues, valuesArray)
Call Module4.BubbleSort(rangeOfValues, valuesArray)
End Sub
Sub IdentificationRangeOfValues(ByRef rangeOfValues, ByRef firstColumn, ByRef lastColumn)
With Worksheets(2)
lastColumn = .Cells(10, .Columns.Count).End(xlToLeft).Column
If lastColumn <= 0 Then MsgBox "Величина lastColumn: " & lastColumn: Exit Sub
firstColumn = .range("A10:FXD10").Find("*").Column
If firstColumn <= 0 Then MsgBox "Величина FirstColumn: " & firstColumn: Exit Sub
Set rangeOfValues = .Cells(10, firstColumn).Resize(1, lastColumn - firstColumn + 1)
' MsgBox rangeOfValues.Cells.Count
End With
End Sub
Sub AuxBubbleSort(ByVal rangeOfValues, ByRef valuesArray)
ReDim valuesArray(1 To rangeOfValues.Cells.Count)
counter = 1
For Each cellChecked In rangeOfValues
valuesArray(counter) = cellChecked
counter = counter + 1
Next cellChecked
End Sub
Sub BubbleSort(ByVal rangeOfValues, ByVal valuesArray)
ReDim valuesArray(1 To rangeOfValues.Cells.Count)
For i = LBound(valuesArray) To UBound(valuesArray) - 1
For j = i + 1 To UBound(valuesArray)
If valuesArray(i) > valuesArray(j) Then
temp = valuesArray(j)
valuesArray(j) = valuesArray(i)
valuesArray(i) = temp
End If
Next j
Next i
End Sub
Коты вообще не работают. Только кот Матроскин иногда. Код следует формлять соответствующим тегом: ищите кнопку <...> и исправьте своё сообщение. В сообщении добавьте, что должен делать макрос.
Коты вообще не работают. Только кот Матроскин иногда. Код следует формлять соответствующим тегом: ищите кнопку <...> и исправьте своё сообщение. В сообщении добавьте, что должен делать макрос.
"Если бы у меня был такой кот... может я и не женился бы никогда" (С) "Каникулы в Прстоквашино" Сергей Иванов, давайте уйдем от обсуждения кота к обсуждению задачи, рассказывайте что решаете (ни как решаете, а что решаете)
для этого, человек, выделяет из своего кода непонятную/нерабочую часть и спрашивает КОНКРЕТНО, почему не работает, и как работать должно, по его мнению. У вас же налицо использование форумов в качестве личных авторешалок.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
даже у задачи для самообучения есть условия: - дано - нужно - особенности вот условия и изложите, приложите файл с данными: 1. на старте данные вот такие 2. хочу получить вот что тот, кто поймет что вы написали сможет ваи показать как это можно сделать пока вы не обьясняли ни 1 и ни 2 помочь вам может только опытный экстрасенс, которому никакие обьяснения ВООБЩЕ не нужны, он считывает тонкие колебания эфира спровоцированные вашими мыслями и легко воспринимает их на любом расстоянии)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
- дано (1. на старте данные): по строке 10 листа 2 вложенного в начале файла приведены цифры в случайном порядке; - нужно (2. хочу получить вот что): бабл-сортом отсортировать в возрастающем или убывающем порядке; - особенности: с целью достижения лучшей читаемости кода решил через основную и вспомогательные процедуры.
Изменено: Сергей Иванов - 07.11.2022 10:32:08(Уточнение)
о — ну это известный ВБАшник! Что ж вы сразу-то не сказали Он, видимо, слишком занят, чтобы на вопросы своей аудитории отвечать? Чего на форумы полезли?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Последний вариант от Киберфорума работает. По окончании процедуры в исходном массиве в Экселе порядок тот же значений, если добавить MsgBox в конце процедуры (' For i = LBound(valuesArray) To UBound(valuesArray) ' MsgBox valuesArray(i) ' Next) или Debug.Print valuesArray(i) & " / "; valuesArray(j) в Имедиэйт, то видно, что программа сортирует в порядке возрастания.
Код
Option Explicit
Dim lastColumn As Long
Dim firstColumn As Long
Dim rangeOfValues As range
Dim i As Long
Dim j As Long
Dim temp As Long
Dim valuesArray() As Long
Dim cellChecked As range
Dim counter As Integer
Sub mainProcedure()
Call IdentificationRangeOfValues
Call AuxBubbleSort
Call BubbleSort
End Sub
Sub IdentificationRangeOfValues()
With Worksheets(2)
lastColumn = .Cells(10, .Columns.Count).End(xlToLeft).Column
If lastColumn <= 0 Then MsgBox "Величина lastColumn: " & lastColumn: Exit Sub
firstColumn = .range("A10:FXD10").Find("*").Column
If firstColumn <= 0 Then MsgBox "Величина FirstColumn: " & firstColumn: Exit Sub
Set rangeOfValues = .Cells(10, firstColumn).Resize(1, lastColumn - firstColumn + 1)
' MsgBox rangeOfValues.Cells.Count
End With
End Sub
Sub AuxBubbleSort()
ReDim valuesArray(1 To rangeOfValues.Cells.Count)
counter = 1
For Each cellChecked In rangeOfValues
valuesArray(counter) = cellChecked
counter = counter + 1
Next cellChecked
End Sub
Sub BubbleSort()
For i = LBound(valuesArray) To UBound(valuesArray) - 1
For j = i + 1 To UBound(valuesArray)
If valuesArray(i) > valuesArray(j) Then
temp = valuesArray(j)
valuesArray(j) = valuesArray(i)
valuesArray(i) = temp
End If
Next j
Next i
End Sub
Изменено: Сергей Иванов - 07.11.2022 12:48:18(актуализировал)
см. вложение в последней функции SortTo направление сортировки управляется значением из ячейки А14 (в А14 знак > сортировка по убывания (от больших к меньшим), иначе - по возрастанию)
Код
Sub Start()
Dim a, b
a = [b10].CurrentRegion
[b12].Resize(UBound(a), UBound(a, 2)) = SortUpToDown(a)
[b13].Resize(UBound(a), UBound(a, 2)) = SortDownToUp(a)
End Sub
Function SortUpToDown(b)
Dim a, i&, j&, k&, c
a = b
For i = 2 To UBound(a, 2)
For j = 1 To i - 1
If a(1, i) > a(1, j) Then
c = a(1, i)
For k = i To j + 1 Step -1: a(1, k) = a(1, k - 1): Next
a(1, j) = c: Exit For
End If
Next
Next
SortUpToDown = a
End Function
Function SortDownToUp(b)
Dim a, i&, j&, k&, c
a = b
For i = 2 To UBound(a, 2)
For j = 1 To i - 1
If a(1, i) < a(1, j) Then
c = a(1, i)
For k = i To j + 1 Step -1: a(1, k) = a(1, k - 1): Next
a(1, j) = c: Exit For
End If
Next
Next
SortDownToUp = a
End Function
Function SortTo(What, Optional How$ = ">")
Dim a, i&, j&, k&, c, cnd As Boolean
a = What
For i = 2 To UBound(a, 2)
For j = 1 To i - 1
If How = ">" Then cnd = a(1, i) > a(1, j) Else cnd = a(1, i) < a(1, j)
If cnd Then
c = a(1, i)
For k = i To j + 1 Step -1: a(1, k) = a(1, k - 1): Next
a(1, j) = c: Exit For
End If
Next
Next
SortTo = a
End Function
Уважаемый Игорь! Высокие материи! С++ просто, не Бэйсик! Изучу. С меня 0.5. Свой вариант дебаггингами проверю и исправлю. Надо в суть вникнуть, овладеть скиллом. Потом Ваше решение изучу. Игорь - forever!