2 семестр / vba_2002

Function NonStaticRandl)

' Возвращает случайное число, которое 1 изменяется при каждом пересчете Application.Volatile True NonStaticRand = Rnd()

End Function

При использовании аргумента False метода V o l a t i l e функция пересчитывается только тогда, когда в результате пересчета изменяется один из ее аргументов (если функция не имеет аргументов, этот метод не выполняется).

Чтобы вызвать полный пересчет формул, в том числе и неизменных пользовательских функций, нажмите <Ctrl+Alt+F9>. Эта комбинация клавиш, к примеру, генерирует новые случайные числа с помощью функции staticRand, представленной выше е этой главе.

Функция с одним аргументом

В этом разделе описана функция, используемая для подсчета комиссионных с объем продаж одного из менеджеров. Вычисления основываются на следующей таблице значений.

Продажи за месяц	Ставка комиссионных
0-S9999	8,0%
$10000-$199ЭЭ	10,5%
$20000-$39999	12,0%
$40000 и больше	14,0%

Обратите внимание, что ставка комиссионных изменяется нелинейно и зависит от общего объема продаж за месяц. Служащие, которые продают больше, получают более высокие комиссионные.

Существует несколько способов вычислить комиссионные для различных объемов продаж, введенных в таблицу Excel. Потратив немного времени, вы можете получить длинную формулу, подобную приведенной ниже:

=ЕСЛИ(И(А1>=0;А1<=9999,99);А1*0,08;

ЕСЛИ<И(А1>=10000;А1<=19999,99};А1*0,105; ЕСЛИ{И<А1>=20 000;А1<=3 9999,99);А1*0,12; ECJIMF(A1>=4OOOO;A1*O,14;0}))}

Такая идея неудачна по нескольким причинам. Во-первых, формула чрезмерно сложна, и ее нелегко понять. Во-вторых, значения строго определены в формуле, из-за чего ее сложно изменять.

Рекомендуется применить описанный ниже подход (не требующий программирования на VBA): использовать для вычисления ставки комиссионных функцию просмотра таблицы соответствия ВПР. Например:

=ВПР(А1;таблица;2}*А1

Еще лучше (тогда не нужно использовать таблицу соответствия) создать пользовательскую функцию, представленную далее.

Function Commission{Sales)
Const	T i e r l	= 0 . 0 8
Const	Tier2	= 0.105
Const Tier3 =0.12
Const	Tier4	= 0.14
1 Вычисляет комиссионные с объема продаж
Часть ///. Visual Basic for Applications			249

Select Case Sales

Case 0 To 9999.99: Commission. = Sales * Tierl

Case 10000 To 19999.99: Commission = Sales * Tier2

Case 20000 To 39999.99: Commission = Sales * Tier3 Case Is >= 40000: Commission = Sales * Tier4

End Select

End Function

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

При вводе в ячейку следующей формулы будет получен результат 3000 (объем продаж 25000 соответствует ставке комиссионных 12%);

=Commission(25000)

Даже если на рабочем листе не требуется применять пользовательские функции, их создание значительно упрощает программирование на VBA. Например, если процедура VBA вычисляет комиссионные с продаж, то можно использовать точно такую же функцию и вызвать ее из процедуры VBA. Ниже приведена небольшая процедура, запрашивающая у пользователя объем продаж и использующая функцию Commission для вычисления ставки комиссионных,

Sub CalcComm() Dim Sales as Long

Sales = InputBox("Введите объем продаж:")

MsgBox "Комиссионные составляют " & Commiss ion(Sales)

End Sub
Процедура CalcComm сначала отображает окно ввода данных
и запрашивает у пользователя объем продаж. Затем она отобража-
ет окно сообщения с вычисленными комиссионными для введен-
ного объема продаж.
Данная процедура выполняется, но имеет неидеальное со-
стояние. Ниже показана усовершенствованная версия, отобра-
жающая отформатированные значения и предлагающая повто-		Рис. W.3. Использование
рить цикл вычислений, пока пользователь не щелкнет на кнопке		функции для отображения
Нет (рис. 10.3).		результата вычислений
Sub CalcComm()
Dim Sales	as Long
Dim Msg As	String, Ans As String

' Запрос ввести объем продаж

Sales = Val(InputBoxf"Введите объем продаж:", _ "Калькулятор комиссионных с продаж"))

' Создание сообщения

Msg = "Объем продаж: " & vbTab & Format (Sales, "S#i##0 . 00") Msg = Msg & vbCrLf & "Комиссионные:" & vbTab

Msg = Msg & Format(Commission(Sales), "$#,##0.00") Msg = Msg & vbCrLf & vbCrLf & "Новое вычисление?"

' Отображение результата и запрос следующего вычисления

Ans = MsgBox(Msg, vbYesNo, "Калькулятор комиссионных с продаж") If Ans = vbYes Then CalcComm

End Sub

Эта функция использует две встроенные константы VBA: vbTab обозначает табуляцию (чтобы отделить результат), a vbCrLf определяет возврат каретки (для перехода на следующую строку). Функция VBA Format указывает значение в заданном формате (в данном случае со знаком доллара, запятой для разделения разрядов и двумя десятичными знаками).

250	Глава 10. Созданиефункций

В обоих этих примерах функция Commission должна содержаться в активной рабочей книге; в противном случае Excel отображает сообщение об ошибке, указывающее, что функция неопределена.

Функция с двумя аргументами

Представим, что менеджер, о котором речь шла выше, отображает новую политику, разработанную для уменьшения текучести кадров: общая сумма комиссионных, подлежащих выплате, увеличивается на 1% за каждый год, который служащий проработал в компании.

Изменим специальную функцию Commission (описанную в предыдущем разделе) так, чтобы она принимала два аргумента. Новый аргумент представляет количество лет работы в компании. Назовем эту новую функцию Commission2.

Function Commission2(Sales, Years)

'Вычисляет комиссионные с продаж

'на основе рабочего стажа в компании Const Tierl = 0.08

Const Tier2 = 0.105 Const ТаегЗ =0 . 12 Const Tier4 = 0.14 Select Case Sales

Case 0 To 9999.99: Commission2 = Sales * Tierl

Case 10000 To 19999.99: Commission^ = Sales * Tiec2

Case 20000 To 39999.99: Commission2 = Sales * Tier3 Case Is >= 40000: Coramisaion2 = Sales * Tier4

End Select

Commission2 = Commiasion2 + (Commission2 * Years / 100) End Function

Довольно просто, правда? Добавим второй аргумент (Years) в оператор Function и применимдополнительные вычисления, изменяющие формулукомиссионных.

Далее приведен пример написания формулы с использованием этой функции (предполагается, что объем продаж задан в ячейке А1, а количество лет, которые проработал в компании рассматриваемый служащий, указано в ячейке В1):

=Commission2(Al;Bl)

Функция с аргументом массивом

Функции могут также в качестве аргументов принимать один или несколько массивов, обрабатывать этот массив (массивы) и возвращать единственное значение. Функция, представленная ниже, принимает как аргумент массив и возвращает сумму его элементов.

Function SuinArray(List) As Double Dim Item As Variant

SumArray = 0

For Each Item In List

If WorksheetFunction. isNumber (Item) Then __

SumArray = SumArray + Item Next Item

End Function

Функция Excel IsNumber проверяет, является ли каждый элемент числом, прежде чем до-
бавить его к общему целому. Добавление этого простого оператора проверки данных устраняет
ошибки несоответствия типов при попытке выполнить арифметическую операцию над строкой.
Часть ///. Visual Basic for Applications	251

Следующая процедура демонстрирует, как вызвать эту функцию в процедуре. Процедура MakeList создает 100-элементный массив и присваивает каждому элементу массива случайное число. Функция MsgBox отображает сумму значений массива в результате вызова функции SumArray.

Sub MakeList()

Dim Numsd To 100) As Double Dim i as Intege r

For i = 1 To 100 Hums(i) = Rnd * 1000

Next i

MsgBox SumArray (Nums) End Sub

Так как функция SumArray не объявляет тип данных своего аргумента (и аргумент имеет тип Variant), то она работает также и в формулах рабочего листа. Например, следующая формула возвращает сумму значений в диапазоне А1 ;С10:

=SumArray(Al:C10)

Возможно, вы заметили, что при использовании в формуле функция SumArray подобна функции Excel СУММ, Единственное отличие заключается в том, что функция SumArray не принимает несколько аргументов (а СУММ может насчитывать до 30-ти). Не стоит забывать, что этот пример приведен только в целях обучения. Функция SumArray в формуле не имеет абсолютно никаких преимуществ перед функцией Excel СУММ.

Функция с необязательными аргументами

Многие встроенные функции Excel имеют необязательные аргументы. Пример— функция ЛЕВСИКВ, возвращающая символы с левого края строки. Она использует следующий синтаксис:

ЛЕВСИМВ(текст[;кол_символов])

Первый аргумент — обязательный, а второй — нет. Если не указан второй аргумент. Excel предполагает значение 1, Следовательно, две формулы, приведенные ниже возвращают одинаковые результаты:

ЛЕВСИМВ(А1;1)

ЛЕВСИМВ{А1>

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

Далее приведен пример пользовательской функции с необязательным аргументом. Эта функция случайным образом выбирает одну ячейку из диапазона данных и возвращает содержимое этой ячейки. Если второй аргумент имеет значение ИСТИНА, то выделенное значение изменяется при каждом пересчете рабочего листа. Если второй аргумент имеет значение ЛОЖЬ (или не задан), функция не пересчитыкается, кроме тех случаев, когда изменяется одна из ячеек диапазона введенных данных.

Function Draw(Rng As Variant, Optional Recalc As Boolean = False}

'Случайным образом выбирает одну ячейку из диапазона

'Функция изменяемая, если Recalc имеет значение True Application.Volatile Recalc

'Определить случайную ячейку

252	Глава 10. Создание функций

•raw = Rng(Int((Rng.Count) * Rnd + 1)) End Function

Обратите внимание, что второй аргумент функции Draw включает ключевое слово O p t i o n a l , а также значение по умолчанию.

Все приведенные ниже формулы корректны, причем первые две возвращают одинаковые результаты:

=Draw(Al:A100)

=Draw(Al:A100;False) =Draw(Al:Al00,-True)

Эта функция может быть полезной для выбора лотерейных номеров, победителя из списка имен и т.д.

Функция VBA, возвращающая массив

VBA содержит весьма полезную функцию с названием Array . Функция A r r a y возвращает значение с типом данных V a r i a n t , которое содержит массив (то есть несколько значений). Если вы знакомы с формулами массивов в Excel, то сможете легко разобраться в функции A r r a y в VBA. Формула массива вводится в ячейку после нажатия <Ctrl+Shift+Enter>. Excel добавляет вокруг формулы скобки, чтобы указать, что это формула массива. Более подробную информацию о формулах массивов вы найдете в главе 3.

Важно понимать, что массив, который возвращает функция Array, — это не гот обычный массив, который составлен из элементов с типом данных Variant. Другими словами, массив Variant — не то же самое, что массив значений типа Variant.

Функция MonthNames, приведенная ниже, — простой пример применения функции Ar- r a y в пользовательской функции:

Function MonthNames()

MonthNames = Array("Январь", "Февраль", "Март", "Апрель", _ "Май", "Июнь", "Июль", "Август", "Сентябрь", "Октябрь", _ "Ноябрь", "Декабрь")

End Function

Функция MonthNam.es возвращает горизонтальный массив названий месяцев. Вы можоте создать формулу массива для нескольких ячеек, использующую функцию MonthNames. Прежде, чем ее использовать, убедитесь, что в модуле VBA введен текст функции. Затем на рабочем листе выделите несколько ячеек в строке (для начала выделите 12 ячеек), введите следующую формулу и нажмите <Ctrl+Shift+Enter>:

^MonthNames{)

На рис. 10.4 показан результат. Важно понимать, что одна формула отображает результат в 12-ти ячейках (в данном случае в диапазоне Al: L1).

Рис. 10.4. Использование функции МопtbNemesвформулемассива

Часть III. VisualBasic forApplications

253

Если необходимо сгенерировать вертикальный массив названий месяцев, выделите вертикальный диапазон, введите следующую формулу и нажмите <Ctrl+Shift+Enter>: =ТРАНСП(MonthNames())

Данная формула использует функцию Excel ТРАНСП для преобразования горизонтального массива в вертикальный.

Следующий пример •— вариация на тему функции MonthNames.

Function MonthNames() Dim AllNames As Variant

AllNames = Array("Январь", "Февраль", "Март", "Апрель", _ "Май", "Июнь", "Июль", "Август", "Сентябрь", "Октябрь", _ "Ноябрь ", "Декабрь")

If isMissing(MIndex) Then

	MonthNames = AllNames
	Else
	Select Case MIndex
	Case Is >= 1
1	Определить, значение месяца (например, 13=1)

MonthVal = ({MIndex - 1) Mod 12)

MonthNames = AllNames(MonthVal)

Case Is <= 0 ' Вертикальный массив

MonthNames = Application.Transpose(AllNames)

End Select

End If

End Function

Обратите внимание, что для проверки незаданного аргумента используется функция VBA I s M i s s i n g , В данной ситуации невозможно задать значение по умолчанию для незаданного аргумента в списке аргументов функции, так как значение по умолчанию определяется в функции. Функцию I s M i s s i n g можно использовать, только если необязательный аргумент имеет тип V a r i a n t .

Эта усовершенствованная функция использует необязательный аргумент, который необходим для выполнения некоторых задач.

•Если аргумент не задан, функция возвращает горизонтальный массив названий месяцев.

•Если аргумент меньше или равен 0, функция возвращает вертикальный массив названий месяцев. Для преобразования массива используется функция Excel ТРАНСП.

•Если аргумент больше или равен 1, функция возвращает название месяца, соответствующее значению аргумента, В этой процедуре использован уже немного знакомый

вам оператор Mod для определения значения месяца. Оператор Mod возвращает остаток от деления первого операнда на второй. Например, аргумент 13 возвращает 0, аргумент 24 возвращает 11 и т.д.

1 Вы можете использовать данную функцию разными способами, как показано на рис. 10.5. Диапазон Al: L1 содержит следующую формулу, введенную как массив. Для начала вы-

делите Al: L1, затем введите формулу и нажмите <Ctrl+Shift+Enter>: =MonthNames()

Вдиапазоне A3: А14 находятся целые числа от 1 до 12. Ячейка ВЗ содержит обычную формулу, которая скопирована в 11 ячеек, следующих за ней:

=MonthNames(A3)

Вдиапазоне D3 : D14 располагается формула, введенная как массив:

=MonthNames(-1)

254	Глава 10. Создание функций

Рис,/0,5.Несколькоспособовпередачиврабочийлистмассиваилиодногозначения

Помните, что для ввода формулы массива необходимо нажать <Ctrl+Shift+Enter>.

Нижняя граница массива, созданная с помощью функции Array, определяется нижней границей, заданной в операторе option Base вверху модуля. Если оператор Option Base не задан, то по умолчанию используется нижняя граница 0.

Функция, возвращающая значение ошибки

В некоторых случаях необходимо, чтобы пользовательская функция возвращала значение ошибки. Рассмотрим функцию R e v e r s e , которая была представлена ранее в этой главе.

Function Reverse(InString) As String ' Возвращает обратную строку

Dim i as Integer, StringLength as Integer Reverse = ""

StringLength к Len (InString)

For i = StringLength To 1 Step -1 Reverse = Reverse & Mid(InString, i, 1)

Next i

End Function

При использовании в формуле на рабочем листе эта функция переставляет символы своего аргумента (текста или значения) в обратном порядке. Предположим, вы хотите, чтобы функция работала только с текстовыми строками. Если аргумент содержит нестроковый тип данных, то необходимо, чтобы функция возвращала значение ошибки (#Н/ Д).

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

Reverse = "#Н/Д"

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

К счастью, в VBA содержатся встроенные константы для обозначения ошибок, которые должна возвращать пользовательская функция. Эти значения — ошибки выполнения формул Excel, а не ошибки выполнения кода VBA. Ниже приведен список встроенных констант ошибок.

Часть III. Visual basic for Applications

255

•xlErrDivO (для ошибки #ДЕЛ/0 !);

•xlErrNA (для ошибки #Н/Д);

•xlErrName (для ошибки #ИМЯ?);

•xlErrNull (дляошнбкн #ПУСТО!>;

•xlErrNum (для ошибки #ЧИСЛО! ):

•xlErrRef (для ошибки #ССШ1! );

•xlErrValue (ДЛЯ ошибки #ЗНАЧ!}.

Чтобы получить ошибку #Н/Д в пользовательской функции, примените следующий оператор: Reverse = CVErr(xlErrNA)

Ниже приведена переделанная функция Reverse. Она вызывает функцию Excel ETEKCT (IsText) для определения, содержит ли аргумент текст. Если ячейка содержит текст, то функция возвращает нормальный результат. Если же ячейка содержит не текст (или пуста), то

функция возвращает ошибку #Н/Д.
Function Reverse(InString)		as Variant
' Если аргумент -	строка,	возвращает	обратную строку
1 В противном случае возвращает ошибку #N/A
Dim i as Integer,	StringLength as Integer
If Application.WorksheetFunct.ion. IsText (InString) Then
Reverse = ""
StringLength = Len{InString)
For i = StringLength To 1 Seep -1
Reverse = Reverse & Mid(InString,			i, I)
Next i
Else
Reverse = CVErr{xlErrNA)

End If

End Function

Обратите внимание, что был тгэкже изменен тип данных для значения, которое возвращает функция. Так как функция может теперь возвращать что-то еще, кроме строки, то я изменил тип данных на variant .

Функция с неопределенным количеством аргументов

Некоторые функции Excel имеют неопределенное количество аргументов. Знакомый пример — функция СУММ, которая использует такой синтаксис:

СУММ(число1;число2;..)

Первый аргумент обязателен, но ложно задавать до 29-ти дополнительных аргументов. Ниже приведен пример функции СУММ с чсгырьмя_аргументами-диапазонами. CyMM(Al:A5;Cl:C5rEl:E5;Gl:G5)

Вы можете использовать в функции разные типы аргументов. Например, следующий пример иллюстрирует использование трех аргументов: первый— диапазон, второй— значение, а третий — выражение:

=СУММ(А1:А5;12;24*3)

Существует возможность создавать функции, имеющие неопределенное число аргументов. Основная идея заключается в применении в качестве последнего массива (или единственного аргумента) и добавлении перед ним ключевого слова ParamArray.

256	Глава 10. Создание функций

ParamArray относится только к последнему аргументу в списке аргументов процедуры. Он всегда определяет тип данных variant и только необязательный аргумент (хотя ключевое слово Optional не используется).

Ниже представлена функция, которая может иметь произвольное количество одномерных.

аргументов (она не поддерживает многомерные аргументы-диапазоны). Функция возвращает сумму аргументов.

Function SimpleSum(ParamArray arglist() As Variant) As Double For Each arg In arglist

SimpleSum = SimpleSum + arg Next arg

End Function

Функция SimpleSum далеко не такая гибкая, как функция Excel СУММ. Протестируйте ее на практике с разными типами аргументов, и вы убедитесь, что функция выдает ошибку, если все аргументы не являются либо значением, либо ссылкой на одну ячейки, содержащие значения.

Создание аналога функции Excel СУММ

В данном разделе представлена пользовательская функция с названием MySum. В отличие От функции SimpleSum, рассмотренной в предыдущем разделе, функция MySum идеально копирует поведение функции Excel СУММ.

Перед рассмотрением кода функции MySum уделим внимание функции Excel СУММ. Данная функция имеет очень широкие возможности. Она насчитывает до ЗО-ти аргументов (даже пропущенные аргументы), причем аргументами могут выступать числовые значения, ячейки, диапазоны, представленные в виде текста числа, логические значения и даже встроенные функции. Рассмотрим следующую формулу:

=СУММ(В1;5;"6";;ИСТИНА;КОРЕНЬ(4);А1:А5)

Данная полностью корректная формула содержит все типы аргументов, перечисленные в порядке их употребления в функции:

•ссылку на одну ячейку;

•символьное значение;

•строку, которая выглядит как числовое значение;

•пропущенный аргумент

•логическое значение ИСТИНА;

•выражение, использующее другую функцию;

•ссылку на диапазон.

Функция MySum (листинг 10.1) также обрабатывает все эти типы аргументов.

Рабочую книгу, которая содержит функцию MySum, можно найти на Web-узпе издательства.

'Объявление переменных Dim i As Variant

Dim TempRange As Range, cell As Range Dim ECode As String

MySum = 0

1Обработка каждого аргумента For i = 0 To UBound(args)

'Пропуск аргументов

If Not IsMissinglargs{i)) Then

'Определение типа аргумента Select Case TypeName(args(i))

Case "Range"

Создание временного диапазона для строки/столбца

Set TempRange = Intersect(args(i).Parent.UsedRange,_ args(i))

For Each cell In TempRange If IsError(cell) Then

MySum = cell ' return the error Exit Function

End If

If cell = True Or cell = False Then MySum = MySum + 0

Else

If IsNumeric(cell) Or IsDate(cell) Then MySum_ = MySum + cell

End If Next cell

Case "Null" 'игнорирование

Case "Error' 'возвращение к ошибке MySum = args(i)

Exit Function Case "Boolean"

If args(i) = "True" Then MySum = MySum + 1 Case "Date"

MySum = MySum + args(i) Case Else

MySum = MySum + args{i) End Select

End If Next i

End Function

При анализе кода функцииMySum помните о следующем.

•Пропущенные аргументы (определенные с помощью функции I s M i s s i n g ) просто игнорируются.

•Процедура использует для определения типа аргумента (Range, E r r o r и т.д.) функцию VBATypeName.Каждыйтипаргумента обрабатываетсяопределеннымспособом.

•Для аргумента-диапазона фунюшя циклически просматривает все ячейки диапазона и прибавляетих значения к сумме.

•Функция имеет тип данных V a r i a n t , так как она должна возвращать ошибку, если один из ее аргументов имеет значениеошибки.

•Если аргумент содержит ошибку (например, #ДЕЛ ! /0), то функция MySum возвращает ошибку— как и функцияExcel СУММ.

258	Глава 10. Создание функций