§2. Примеры пользовательских функций
В приложении Excel имеется достаточное количество функций, предназначенных для работы с текстом, числовой информацией, датой, массивами и другими типами данных, но, иногда, пользователь может столкнуться с ситуацией, которой не соответствует ни одна существующая функция. В таком случае пользователю предоставляется прекрасная возможность создать свою собственную функцию для заданного рабочего листа с использованием встроенного языка программирования VBA.
Функции для работы с текстом
Функция Перевертыш возвращает в заданную ячейку текст, располагая в нем символы в обратном порядке. Например, если в функцию как аргумент введен текст клавиатура, то возвращается текст арутаивалк.
Пример 1. Перевертыш
Function Перевертыш(Исходное_слово)
Результат = ""
For i = 1 To Len(Исходное_слово)
Результат = Mid(Исходное_слово, i, 1) + Результат
Next
Перевертыш = Результат
End Function
Функция Первое_слово возвращает часть текста до первого пробела. Например, если в функцию как аргумент введен текст мы желаем счастья вам, то возвращается текст мы.
Пример 2. Первое слово текста
Function Первое_слово(Текст)
i = 1
While Mid(Текст, i, 1) <> " " And i < Len(Текст)
i = i + 1
Wend
If i < Len(Текст) Then
Первое_слово = Mid(Текст, 1, i - 1)
Else
Первое_слово = Текст
End If
End Function
Функция ФИО предназначена для получения из полного имени имя в формате Фамилия И. О. Например, если в функцию как аргумент введен текст Иванов Иван Иванович, то возвращается текст Иванов И. И.
Пример 3. Имя в формате Фамилия И. О.
Function ФИО(Текст) As Variant
Dim Данные(3) As Variant
i = 0
While Len(Текст) > 0
Данные(i) = Первое_слово(Текст)
Текст = Mid(Текст, Len(Данные(i)) + 2)
i = i + 1
Wend
ФИО = Данные(0) + " " + Mid(Данные(1), 1, 1) + ". " + Mid(Данные(2), 1, 1) + "."
End Function
Данная функция позволяет сократить формулу
=ЛЕВСИМВ(B21;НАЙТИ(" ";B19))&ПСТР(B19;НАЙТИ(" ";B19)+1;1)&
". "&ПСТР(B19;НАЙТИ(" ";B19;НАЙТИ(" ";B19)+1)+1;1)&"." ,
которая выполняет аналогичную операцию.
Вспомогательная функция ЗНПРЕП возвращает значение истина, если указанный символ совпадает с одним из знаков препинания или пробелом.
Пример 4. Является ли символ знаком препинания
Function ЗНПРЕП (k)
ЗНПРЕП = False
Знаки = " ,.?!():;"
For j = 1 To Len(Знаки)
If Mid(Знаки, j, 1) = k Then ЗНПРЕП = True
Next
End Function
Функция Телеграмма предназначена для получения стоимости телеграммы. Аргументами для данной функции являются текст – текст телеграммы и стоимость – стоимость одного слова и знака препинания.
Пример 5. Стоимость телеграммы
Function Телеграмма(Текст, Стоимость) As Variant
If Len(Текст) = 0 Then
Количество = 0
Else
Количество = 1
End If
For i = 1 To Len(Текст)
If ЗНПРЕП(Mid(Текст, i, 1)) = True Then
Количество = Количество + 1
End If
Next
Телеграмма = Количество * Стоимость
End Function
Функции для обработки числовой информации.
При написании функций в VBA можно обращаться к встроенным функциям рабочего листа. Следующая функция получает сумму элементов массива, используя встроенную функцию СУММ (Sum).
Пример 6. Сумма элементов(способ 1)
Function Сумма1(Массив)
Сумма1 = Application.Sum(Массив)
End Function
Пример 7. Сумма элементов(способ 2)
Function Сумма2(Massiv)
Dim cell As Range
Set Massiv = Intersect(Massiv.Parent.UsedRange, Massiv)
Сумма = 0
For Each cell In Massiv
Сумма = Сумма + cell.Value
Next
Сумма2 = Сумма
End Function
Здесь функция Intersect возвращает диапазон, образованный пересечением двух диапазонов. Massiv.Parent.UsedRange возвращает используемый диапазон рабочего листа, на котором находится массив Massiv. Эта конструкция используется для оптимизации вычислений для исключения пустых ячеек, которые могут находиться в Massiv
В следующей процедуре функции принимается аргумент одной ячейки и используется цикл For-Next для возращения суммы 7 ячеек, находящихся под выбранной ячейкой включая ячейку аргумента:
Пример 8. Сумма элементов(способ 3)
Function Сумма3(Ячейка As Range)
Сумма = 0
For i = 0 To 6
Сумма = Сумма + Ячейка.Offset(i, 0)
Next
Сумма3 = Сумма
End Function
Здесь свойство Offset (как и свойства Range и Cells) также возвращает объект Range. Свойство Offset применяется к диапазону. Оно принимает два аргумента, соответствующие относительному расположению левой верхней ячейки определенного объекта Range. Аргументы могут быть положительными, отрицательными или равными нулю.
Функция Макс_со_всех_листов возвращает максимальное значения из определенной ячейки всех рабочих листов.
Чтобы определить максимальное значение (например, В1) на нескольких рабочих листах, можно использовать такую формулу: =МАКС(Лист1:Лист4!В1)
Эта формула возвращает максимальное значение ячейки В1 листов Лист1, Лист4 и всех листов, находящихся между ними. Но что делать, если после Лист4 нужно добавить новый лист (Лист5)? Формула автоматически не обновляется, поэтому нужно отредактировать ее и добавить ссылку на новый лист: =МАКС(Лист1:Лист5!В1)
Функция Макс_со_всех_листов принимает аргумент одной ячейки и возвращает максимальное значение этой ячейки на всех рабочих листах рабочей книги. Например, приведенная ниже формула возвращает максимальное значение ячейки В1 на всех листах рабочей книги.
= Макс_со_всех_листов (Bl)
При добавлении нового листа редактировать формулу не нужно.
Пример 9. Возвращение максимального значения из рабочих листов
Function Макс_со_всех_листов(cell As Range)
Dim MaxVal As Double
Dim Addr As String
Dim Wksht As Object
Application.Volatile
Addr = cell.Range("A1").Address
MaxVal = -9.9E+307
For Each Wksht In cell.Parent.Parent.Worksheets
If Wksht.Name = cell.Parent.Name And _
Addr = Application.Caller.Address Then
Else
If IsNumeric(Wksht.Range(Addr)) Then
If Wksht.Range(Addr) > MaxVal Then _
MaxVal = Wksht.Range(Addr).Value
End If
End If
Next Wksht
If MaxVal = -9.9E+307 Then MaxVal = 0
Макс_со_всех_листов = MaxVal
End Function
Родителем ячейки является рабочий лист, а родителем рабочего листа — рабочая книга. Таким образом, цикл Each-Next обрабатывает все рабочие листы в рабочей книге. Первый оператор If внутри цикла выполняет проверку на наличие функции в проверяемой ячейке. Если функция обнаружена, ячейка игнорируется во избежание ошибки циклической ссылки.
Функция Вознаграждение рассчитывает размер приза за полученное место участникам соревнований исходя из размера призового фонда. За первое место призер получает половину от всего призового фонда, второму и третьему место достается 3/10 и 2/10 фонда соответственно. За остальные места выводится благодарность за участие. Аргументами функции служат призовой фонд и полученное место.
Пример 10. Размер вознаграждения за занятое место
Function Вознаграждение(Объем_призового_фонда, Место)
Select Case Место
Case 1
Вознаграждение = 0.5 * Объем_призового_фонда
Case 2
Вознаграждение = 0.3 * Объем_призового_фонда
Case 3
Вознаграждение = 0.2 * Объем_призового_фонда
Case Else
Вознаграждение = "Спасибо за участие!"
End Select
End Function
Функция Комиссионные.
Менеджерам по продажам часто необходимо просчитать комиссионные, полученные от продаж. Расчеты могут быть основаны на подвижной шкале: чем больше работник продал, тем больше комиссионных он получил.
Комиссионные можно вычислить для различных объемов продаж, указанных на рабочем листе. Можно использовать сложную формулу со вложенными функциями IF, например:
=IF(Al<0;0;IF(Al<10000;Al*0,08;IF(Al<20000;А1*0,105;IF(А1<40000;А1*0,1 2;А1*0,14))))
Но это не наилучший способ по нескольким причинам. Во-первых, формула получается слишком громоздкой и запутанной, что затрудняет ее понимание. Во-вторых, значения в формуле указываются жестко, что затрудняет внесение изменений в формулу. И если есть больше семи процентных ставок, то запись функции выйдет за ограничения по вложенным функциям Excel.
Если структура начисления комиссионных более сложная, следует воспользоваться дополнительными аргументами в функции. Например, менеджер по продажам внедряет новую политику, чтобы уменьшить текучесть кадров: общие комиссионные повышаются на 1% в год, пока агент по продажам работает на эту компанию.
Ниже приведена функция Комиссионные. Эта функция принимает два аргумента: объем продажи за месяц (Цена_проданного_товара) и количество отработанных в компании лет (Стаж).
Пример 11. Вычисление комиссионных
Function Комиссионные(Цена_проданного_товара, Стаж) As Single
' Вычисляет комиссионные с продаж на основе рабочего стажа
Const Tierl As Double = 0.1
Const Tier2 As Double = 0.105
Const Tier3 As Double = 0.12
Const Tier4 As Double = 0.14
Select Case Цена_проданного_товара
Case Is >= 40000
Комиссионные = Цена_проданного_товара * Tier4
Case Is >= 20000
Комиссионные = Цена_проданного_товара * Tier3
Case Is >= 10000
Комиссионные = Цена_проданного_товара * Tier2
Case Is < 10000
Комиссионные = Цена_проданного_товара * Tierl
End Select
Комиссионные = Комиссионные + Комиссионные * Стаж / 100
End Function
Функция Число_прописью возвращает числу его текстовый эквивалент. Число может принимать значение от 1 до 999. Например, если в качестве аргумента выступает число 123, то функция возвратит строку сто двадцать три. Подобные функции могут быть полезны при распечатке отчетов с наличием денежных средств, где требуется выводить сумму прописью.
Пример 12. Возвращение числу его текстового эквивалента
Function Число_прописью(n As Integer)
num19 = Array("", "один", "два", "три", "четыре", "пять",_ "шесть","семь", "восемь", "девять", "десять", "одиннадцать", "двенадцать",_ "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", "семнадцать",_ "восемнадцать", "девятнадцать")
num20 = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ",_ "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
num100 = Array("", "сто ", "двести ", "триста ", "четыреста ",_ "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
If n < 20 Then
Число_прописью = num19(n)
Else
If n Mod 100 < 20 Then
nn = num19(n Mod 100)
n = Int(n / 100)
Else
nn = num19(n Mod 10)
n = Int(n / 10)
nn = num20(n Mod 10) + nn
n = Int(n / 10)
End If
nn = num100(n Mod 10) + nn
Число прописью = nn
End If
End Function
|
