Использование массивов в качестве аргументов процедур и функций

VBA допускает использование массивов в качестве аргументов процедур и функций. В этом случае массив-параметр объявляется как динамический массив инструкцией вида:

[ ByVal | ByRef ]имяМассива () As тип, где

ByVal - VBA передает аргумент-массив по значению,

ByRef - VBA передает аргумент-массив по ссылке,

Тип – любой из допустимых типов.

Не рекомендуется передавать массивы в качестве аргументов процедур и функций по значению, т.к. в этом случае быстро исчерпываются ресурсы памяти ПК.

Продемонстрируем использование массивов в качестве аргумента процедуры-функции на примерах сортировки одномерного числового массива.

1. Сортировка методом прямого выбора

Этот метод обычно применяется для массивов, не содержащих повторяющихся элементов.
Можно действовать следующим образом:

- выбрать минимальный элемент массива;

- поменять местами с первым элементом (после этого самый маленький будет стоять на своем месте);

- повторить предыдущие пункты с оставшимися элементами, т.е. рассмотреть часть массива от второго до последнего, найти минимальный в нем элемент и поменять его со вторым и т.д. пока не останется один самый большой элемент, уже стоящий на своем месте.

Всего потребуется 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

Если в проверяемом условии знак “<” заменить на “>”, то массив будет отсортирован по убыванию.

1. Сортировка методом прямого обмена (пузырька)

Сортировка методом прямого обмена может быть применена для любого массива. Этот метод заключается в последовательных просмотрах массива сверху вниз (от начала к концу) и обмене местами соседних элементов, расположенных неправильно. Просмотр массива от начала к концу выполняется 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