ИСПОЛЬЗОВАНИЕ МАССИВОВ В КАЧЕСТВЕ АРГУМЕНТОВ ПРОЦЕДУР И ФУНКЦИЙ
VBA допускает использование массивов в качестве аргументов процедур и функций. В этом случае массив-параметр объявляется как динамический массив инструкцией вида:
[ ByVal | ByRef ]имяМассива ( ) As тип, где
ByVal - VBA передает аргумент-массив по значению,
ByRef - VBA передает аргумент-массив по ссылке,
Тип – любой из допустимых типов.
Не рекомендуется передавать массивы в качестве аргументов процедур и функций по значению, т.к. в этом случае быстро исчерпываются ресурсы памяти ПК.
Продемонстрируем использование массивов в качестве аргумента процедуры-функции на примерах сортировки одномерного числового массива.
- Сортировка методом прямого выбора
Этот метод обычно применяется для массивов, не содержащих повторяющихся элементов.
Можно действовать следующим образом:
- выбрать минимальный элемент массива;
- поменять местами с первым элементом (после этого самый маленький будет стоять на своем месте);
- повторить предыдущие пункты с оставшимися элементами, т.е. рассмотреть часть массива от второго до последнего, найти минимальный в нем элемент и поменять его со вторым и т.д. пока не останется один самый большой элемент, уже стоящий на своем месте.
Всего потребуется m - 1 раз выполнить эту последовательность действий. В ходе сортировки будет увеличиваться отсортированная часть массива, а не отсортированная, соответственно, уменьшаться.
Function МетодПрямВыбора (ByRefy( ) As Integer, ByVal m As Byte)
Dim MnAs Integer
Dim k As Byte, j As Byte, L As Byte
For k = 1 To m - 1
Mn = y(k): L = k
For j = k + 1 To m
If y(j) <Mn Then
Mn = y(j): L = j
End if
Next j
y(L) = y(k) : y(k) = Mn
Next k
EndFunction
Если в проверяемом условии знак “<” заменить на “>” , то массив будет отсортирован по убыванию.
- Сортировка методом прямого обмена (пузырька)
Сортировка методом прямого обмена может быть применена для любого массива. Этот метод заключается в последовательных просмотрах массива сверху вниз (от начала к концу) и обмене местами соседних элементов, расположенных неправильно. Просмотр массива от начала к концу выполняется m - 1 раз, после чего массив отсортирован.
Function Методомпрямогообмена (ByRefy( ) As Integer, ByVal m As Byte)
Dim d As Integer, k As Byte, j As Byte
For k = 2 To m
For j = m To k Step -1
If y(j-1) > y(j) Then
d = y(j-1): y(j-1) = y(j): y(j) = d
end if
Next j
Next k
End Function
В методах прямого выбора и пузырька исходные элементы массива должны быть в наличии до начала сортировки.
Проиллюстрируем работу обоих методов сортировки одномерного числового массива, использующих в качестве аргумента функции массив исходных данных при решении следующих задач:
Пример 7. Задан одномерный числовой массив. Найти наибольший и наименьший его элементы.
Sub Ex7( )
Dim x( ) As Integer, n As Byte, i As Byte
n = Application.CountA(ActiveSheet.Range(" A : A "))
ReDimx(1 To n)
For i = 1 To n
x(i) = Cells(i, 1).Value
Next i
CallМетодПрямВыбора(x, n)
MsgBox " Наибольший элемент массива = " &Format(x(m), " 0.000 ")
MsgBox "Наименьший элемент массива = " &Format(x(1), " 0.000 ")
EndSub
Функция CountA( ) из библиотеки MS Excel позволяет подсчитать количество непустых ячеек в столбце А активного (выбранного) рабочего листа.
Примет 8. Задана упорядоченная числовая последовательность и некоторое число. Вставить заданное число в исходную последовательность, не нарушая порядок.
Sub Ex1( )
Dim x( ) As Integer, число As Integer, i As Integer, j As Integer
Const n As Byte = 10
ReDimx(1 To n)
Sheets(" Лист 1 ").Select
Cells.Clear
For i = 1 To n
x(i) = Rnd * 100
Next i
For i = 1 To n
Cells(i, 1).Value = x(i)
Next i
CallМетодом прямого обмена(x, n)
For i = 1 To n
Cells(i, 2).Value = x(i)
Next i
число = InputBox(" введите число ")
If число<x(1) Then
ReDim Preserve x(1 To n + 1)
For j = n To 1 Step -1
x(j + 1) = x(j)
Next j
x(1) = число
End If
If число>x(n) Then
ReDim Preserve x(1 To n + 1)
x(n + 1) = число
Else
ReDim Preserve x(1 To n + 1)
i = 1
Do
If x(i) < = число And число< x(i + 1) Then
For j = n Toi + 1 Step -1
x(j + 1) = x(j)
Next j
x(i + 1) = число
ExitDo
EndIf
i = i + 1
Loop Until i> n + 1
End If
For i = 1 To n + 1
Cells(i, 5) = x(i)
Nexti
EndSub