Необходимо упростить - VBA

Формулировка задачи:

Не знаю как по другому отсортировать методом выбора по возрастанию.
Sub ГЊГ*êðîñ1()
Dim a(10), b(10), K, j As Integer
Randomize
For i = 1 To 10
Cells(i, 2) = Int(Rnd * 100 - 50)
a(i) = Cells(i, 2).Value
Next i
K = Val(InputBox("ved choslo"))
For i = 1 To 10
If (i Mod 2 = 0) And (Abs(a(i)) >= K) Then j = j + 1
Next i
Cells(1, 3) = j
MsgBox j
For g = 1 To 10
s_min = a(1)
n = 1
For i = 1 To 10
If a(i) < s_min Then
s_min = a(i)
n = i
End If
Next i
b(g) = s_min
a(n) = 32000
Next g
For i = 1 To 10
Worksheets("Ëèñò1").Cells(i, 4).Value = b(i)
Next i
End Sub

Код к задаче: «Необходимо упростить - VBA»

textual
Sub tim2555()
Dim Массив(1 To 10) As Long
Dim i As Integer, j As Integer
Dim MaxЭлемент As Integer, MaxЗначение As Long
Cells.Clear
For i = 1 To 10
  Cells(i, 1) = Int((30 * Rnd) - 15)
  Cells(i, 3) = Cells(i, 1)  'Копия для проверки!
Next
'Заполняем массив целыми числами из Excel.
For i = 1 To 10 Step 1
    Массив(i) = Cells(i, 1).Value
Next i
'Собственно сортировка методом Прямой выбор.
For i = 1 To 10 - 1 Step 1
    MaxЗначение = Массив(i): MaxЭлемент = i
    For j = i + 1 To 10 Step 1
        If Массив(j) < MaxЗначение Then
            MaxЗначение = Массив(j): MaxЭлемент = j
        End If
    Next j
    Массив(MaxЭлемент) = Массив(i):  Массив(i) = MaxЗначение
Next i
'Вывод результата Сортировки в Excel.
For i = 1 To 10 Step 1
    Cells(i, 1).Value = Массив(i)
Next i
End Sub

14   голосов, оценка 3.929 из 5


СОХРАНИТЬ ССЫЛКУ