Как отсортировать ячейки Excel из макроса VBA?

Просто понадобился пример программной сортировки чисел из кода на VBA.

Отметим, что решать многие счётные задачи в Excel можно как "вручную", программируя типовые алгоритмы, так и вызывая стандартные функции VBA или Excel, если таковые имеются.

Поэтому в примере можно сортировать и "пузырьком", и готовым методом Range.Sort.

В большинстве случаев штудирование MSDN позволяет легко найти ответы, как правильно вызывать тот или иной встроенный метод :)

Служебная функция getArrayFromCells, почти такая же, как здесь, считывает глобальный вещественный массив A из подряд заполненных ячеек столбца "A" и определяет его размерность N.

Функция ClearMe очищает рабочие ячейки листа, а остальные 3 подпрограммы обрабатывают нажатия кнопок "Заполнить", "СОРТИРОВКА" и "СОРТИРОВКА VBA", подробности видны из листинга.

Ниже показан этот листинг и прикреплён файл в архиве .zip с книгой .xlsm (документ Excel с макросами). Если при открытии книги Excel предупреждает о наличии макросов, их выполнение нужно разрешить:

разрешить выполнение макросов в Excel

Public A() As Double
Public N As Integer

Sub getArrayFromCells() 'Получить из столбца A массив чисел
 N = 0: I = 1
 Do While True
  V = Range("A" & I).Value
  If IsEmpty(V) Or IsNumeric(V) = False Then
   Exit Do
  End If
  N = I: I = I + 1
 Loop
 If N < 1 Then
  Range("B1").Value = "Ошибка:"
  Range("C1").Value = Str(N) & " чисел в столбце A"
  Exit Sub
 Else
  Range("B1").Value = "Всего:": Range("C1").Value = N
 End If
 ReDim A(1 To N)
 For I = 1 To N
  A(I) = Val(Range("A" & I).Value)
 Next I
End Sub

Sub ClearMe() 'Очистить лист
 Range("A:A").Select: Selection.Clear
 Range("B1").Select: Selection.Clear
 Range("C1").Select: Selection.Clear
 Range("A1").Select
 N = 0
End Sub

Sub Кнопка1_Щелчок() 'Сортировка массива "вручную"
 Call getArrayFromCells
 'Отсортировать полученный массив:
 For I = 1 To N - 1    'Каждый элемент
  For J = I + 1 To N   'сравнить с оставшимися до конца
   If A(I) > A(J) Then 'и, если нужно, поменять местами
    T = A(I): A(I) = A(J): A(J) = T
   End If
  Next J
 Next I
 'Записать обратно в столбец A:
 For I = 1 To N
  Range("A" & I).Value = A(I)
 Next I
End Sub

Sub Кнопка2_Щелчок() 'Сортировка вызовом функции VBA
 Call getArrayFromCells
 If N > 0 Then
  Range("A1:A" & N).Sort Key1:=Range("A1"), _
   Order1:=xlAscending, Header:=xlNo
 End If
End Sub

Sub Кнопка3_Щелчок() 'Заполнение случайными числами
 Call ClearMe
 N = 10 + Round(Rnd() * 10, 0)
 ReDim A(N)
 Randomize
 For I = 1 To N 'целые числа от -50 до 50
  A(I) = Round(-50 + Rnd() * 100, 0)
  Range("A" & I).Value = A(I)
 Next I
 Range("B1").Value = "Всего:": Range("C1").Value = N
End Sub

 Скачать этот пример в архиве .zip с книгой Excel .xlsm (15 Кб)

Кстати:
Если при вставке кода в редактор Visual Basic for Applications (или вставке куда-либо кода, скопированного из VBA) символы кириллицы превращаются в "кракозябры" или вопросительные знаки, установите русскую раскладку клавиатуры перед копированием в Буфер Обмена.

15.05.2018, 22:30 [6529 просмотров]