Sub Макрос1()
Range("A1:A20").Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
VBA в Excel Отсортировать массив чисел в ячейках по убыванию.
Помогите пожалуйста добрые люди!!))))Как в VBA в Excel отсортировать массив чисел в ячейках по убыванию. Какими операторами пользоваться?? И если сложно напишите примерную программу.. Век благодарен буду!!!!:) ПЛИЗ!!!)))
Я вот так сделал и вот что получилось
Сортируем диапазон A1:A20
Код:
'по убыванию
Order1:=xlDescending
'по возрастанию
Order1:=xlAscending
Смасибо большое сейчас буду пробовать)))
А как нибудь можно сделать через цыклы?? Заранее благоддарствую)))
Сортировка массивов (не помню на каком форуме взял)
Код:
Sub MyBubbleSort(arr, Optional k As Byte = 0) ' Сортировка простым обменом ' ort by [E]lementary [E]xchange
Dim i As Long, j As Long, t As Variant
On Error Resume Next
For i = UBound(arr) To LBound(arr) + 1 Step -1
For j = LBound(arr) To i - 1
If CSng(Left(arr(j), Len(arr(j)) - k)) > CSng(Left(arr(j + 1), Len(arr(j + 1)) - k)) Then
t = arr(j)
arr(j) = arr(j + 1)
arr(j + 1) = t
End If
Next
Next
End Sub
Dim i As Long, j As Long, t As Variant
On Error Resume Next
For i = UBound(arr) To LBound(arr) + 1 Step -1
For j = LBound(arr) To i - 1
If CSng(Left(arr(j), Len(arr(j)) - k)) > CSng(Left(arr(j + 1), Len(arr(j + 1)) - k)) Then
t = arr(j)
arr(j) = arr(j + 1)
arr(j + 1) = t
End If
Next
Next
End Sub
Код:
Sub MyQuickSort(arr, Optional First As Long = -1, Optional Last As Long = -1) ' Быстрая сортировка, [Q]uick ort
Dim i As Long, j As Long, MidEl As Variant, t As Variant
On Error Resume Next
First = IIf(First = -1, LBound(arr), First)
Last = IIf(Last = -1, UBound(arr), Last)
i = First
j = Last
MidEl = arr((First + Last) \ 2)
Do While i <= j
If arr(i) < MidEl Then
i = i + 1
Else
If arr(j) > MidEl Then
j = j - 1
Else
t = arr(i)
arr(i) = arr(j)
arr(j) = t
i = i + 1
j = j - 1
End If
End If
Loop
If First < j Then Call MyQuickSort(arr, First, j)
If i < Last Then Call MyQuickSort(arr, i, Last)
End Sub
Dim i As Long, j As Long, MidEl As Variant, t As Variant
On Error Resume Next
First = IIf(First = -1, LBound(arr), First)
Last = IIf(Last = -1, UBound(arr), Last)
i = First
j = Last
MidEl = arr((First + Last) \ 2)
Do While i <= j
If arr(i) < MidEl Then
i = i + 1
Else
If arr(j) > MidEl Then
j = j - 1
Else
t = arr(i)
arr(i) = arr(j)
arr(j) = t
i = i + 1
j = j - 1
End If
End If
Loop
If First < j Then Call MyQuickSort(arr, First, j)
If i < Last Then Call MyQuickSort(arr, i, Last)
End Sub
Спасибо!!)))