Текст книги "Excel. Трюки и эффекты"

Разработка и применение полезных пользовательских функций

Наряду с формулами функции также являются одним из основных инструментов Microsoft Excel. Функции могут быть как системными (то есть изначально заложенными в программу), так и пользовательскими (пользовательская функция – это функция, созданная пользователем с применением языка VBA).

Далее мы познакомимся с несколькими полезными пользовательскими функциями. При описании применения функций подразумевается, что они выбираются в окне Мастер функций (Формулы → Вставить функцию), однако их можно вводить и в строку формул по обычным правилам Excel.

Функция Couple предназначена для объединения всех данных, которые расположены в указанном диапазоне, с добавлением пробелов между ними. Код данной функции выглядит следующим образом (листинг 2.43).

Листинг 2.43. Функция Couple

Function Couple(Diapazon)

' Объединение данных, содержащихся в ячейках диапазона _

Diapazon (разделитель между значениями – пробел)

' iCell – текущая ячейка

For Each iCell In Diapazon

' Сцепляются данные только заполненных ячеек

If IsEmpty(iCell) <> True Then

' Добавление значения ячейки в выходную строку

If Couple = "" Then

Couple = iCell

Else

Couple = Couple & " " & iCell

End If

End If

Next

End Function

Как обычно, на первом этапе в окне Мастер функций нужно выделить данную функцию и нажать кнопку ОК. На втором этапе следует указать диапазон ячеек, содержимое которых необходимо объединить, и вновь нажать ОК – результат отобразится в ячейке, в которой установлен курсор.

Функция Couple выгодно отличается от стандартной функции СЦЕПИТЬ тем, что легко можно указать произвольный диапазон, а также тем, что объединенные данные разделяются пробелом.

Функция CoupleFormat работает аналогично функции Couple с той разницей, что она объединяет данные указанного диапазона с соблюдением форматов. Код функции представлен в листинге 2.44.

Листинг 2.44. Функция CoupleFormat

Function CoupleFormat(Diapazon)

' Объединение текстовых данных, содержащихся в ячейках _

диапазона Diapazon (разделитель между значениями – пробел)

' iCell – текущая ячейка

For Each iCell In Diapazon

' Сцепляются данные только заполненных ячеек

If IsEmpty(iCell) <> True Then

' Добавление текста ячейки в выходную строку

If CoupleFormat = "" Then

CoupleFormat = iCell.Text

Else

CoupleFormat = CoupleFormat & " " & iCell.Text

End If

End If

Next

End Function

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

В процессе работы с программой иногда возникает необходимость изменить представление даты. Оперативно решить эту задачу поможет функция ДатаПолная. Например, если дата отображается в виде 04.08.2005, то данная функция преобразует ее в вид 0 4 Августа 2 005. Код функции приведен в листинге 2.45.

Листинг 2.45. Функция ДатаПолная

Function ДатаПолная(Ячейка)

' Получение данных в заданной ячейке в формате _

«dd mmmm yyyy»

Дата = Format(Ячейка, «dd mmmm yyyy»)

If IsDate(Ячейка) = True Or IsDate(Дата) = True Then

' Возврат строки с полной датой

ДатаПолная = StrConv(Дата, vbProperCase)

Else

' Данные в ячейке не являются датой

ДатаПолная = «<>»

End If

End Function

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

Несомненным достоинством данной функции является то, что она может преобразовать представление даты даже в тех ячейках, в которых установлен формат, отличный от Дата (Числовой, Текстовый и др.). Например, если в ячейке с форматом Общий содержится число 37808, то в результате применения функции ДатаПолная оно будет преобразовано в дату 06 Июля 2003.

Достаточно интересное решение реализовано в функции ExtractNumeric. С ее помощью из любого текста можно извлечь все числовые значения. Например, если ячейка содержит текст 2 5 сентября 2 004 года, результат применения данной функции будет таким: 252004. Код функции выглядит следующим образом (листинг 2.46).

Листинг 2.46. Функция ExtractNumeric

Function ExtractNumeric(iCell)

' Анализируется каждый символ входной строки iCell

For iCount = 1 To Len(iCell)

' Проверка, является ли анализируемый символ числом

If IsNumeric(Mid(iCell, iCount, 1)) = True Then

' Число добавляется в выходную строку

ExtractNumeric = ExtractNumeric & Mid(iCell, iCount, 1)

End If

Next

End Function

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

Как известно, в Excel есть штатная функция ПРОПНАЧ, которая преобразует все первые буквы слов в тексте в прописные. Однако иногда возникает необходимость сделать так, чтобы в тексте была только одна прописная буква – в начале его первого слова. Решить эту задачу поможет пользовательская функция ПрописнНач. Код функции выглядит следующим образом (листинг 2.47).

Листинг 2.47. Функция ПрописнНач

Function ПрописнНач(Текст)

' Пустой текст функция не обрабатывает

If Текст = "" Then ПрописнНач = «<>»: Exit Function

' Выделение первого символа и перевод его в верхний регистр

ПервыйСимвол = UCase(Left(Текст, 1))

' Выделение остальной части строки и перевод _

ее в нижний регистр

Обрубок = LCase(Mid(Текст, 2))

' Соединение частей строки и возврат значения

ПрописнНач = ПервыйСимвол & Обрубок

End Function

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

Функцию, о которой рассказывается в данном подразделе, наверняка оценят экономисты, а также работники бухгалтерских и финансовых служб предприятий (организаций). С ее помощью можно преобразовать хранящееся в ячейке число в денежное представление: например, число 53 будет отображаться как 53 руб. 0 0 коп., а число 2 7,43 – как 27 руб. 4 3 коп. Данная функция называется RubKop, ее код приведен в листинге 2.48.

Листинг 2.48. Функция RubKop

Function RubKop(Число)

' Пустые ячейки и ячейки, содержащие текст, функция _

не обрабатывает

If IsNumeric(Число) = False Or Число = "" Then RubKop = _

«<>»: Exit Function

' Из числа целой части – рубли

ДлинаЧисла = Len(Число)

ЦелаяЧасть = Fix(Число)

ДлинаЦелой = Len(ЦелаяЧасть)

' Вычисление длины дробной части

ДлинаДроби = ДлинаЧисла – ДлинаЦелой

If ДлинаДроби <> 0 Then

ДлинаДроби = ДлинаЧисла – ДлинаЦелой – 1

End If

' Формирование количества копеек в зависимости от длины _

дробной части

If ДлинаДроби = 0 Then

' Ноль копеек

Копейки = «00»

ElseIf ДлинаДроби = 1 Then

' Дробная часть состоит из одного числа – это _

десятки копеек

Копейки = Right(Число, ДлинаДроби) & "0"

ElseIf ДлинаДроби = 2 Then

' Дробная часть полностью соответствует количеству копеек

Копейки = Right(Число, ДлинаДроби)

Else

' Длина дробной части больше двух – округлим _

дробную часть

Копейки = Right(Число, ДлинаДроби)

If Mid(Копейки, 3, 1) > 4 Then

Копейки = Left(Копейки, 2) + 1

Else

Копейки = Left(Копейки, 2)

End If

End If

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

Рубли = ЦелаяЧасть

RubKop = Рубли & " " & «руб.» & " " & Копейки & " " & «коп.»

End Function

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

Функция CoincideCount позволяет быстро посчитать количество повторов текстового фрагмента в тексте ячеек заданного диапазона. Код функции приведен в листинге 2.49.

Листинг 2.49. Функция CoincideCount

Function CoincideCount(Text, Search)

' Проверка правильности входных данных _

(аргумента Search)

If IsArray(Search) = True Then Exit Function

If IsError(Search) = True Then Exit Function

If IsEmpty(Search) = True Then Exit Function

' Просмотр заданного в параметре Text диапазона

For Each iCell In Text

' Анализируются только ячейки, содержащие _

корректные значения

If Not IsError(iCell) Then

' iText – строка для просмотра (в нижнем регистре)

iText = LCase(iCell)

' iSearch – искомое значение (в нижнем регистре)

iSearch = LCase(Search)

' Длина искомой строки

iLen = Len(Search)

' Первый поиск строки iSearch в строке iText _

(этот и последующий поиски производятся без _

учета регистра символов)

iNumber = InStr(iText, iSearch)

While iNumber > 0

' Поиск следующего вхождения строки

iNumber = InStr(iNumber + iLen, iText, iSearch)

' Подсчет количества вхождений

CoincideCount = CoincideCount + vbNull

Wend

End If

Next

End Function

В отличие от функций, описание которых приведено выше, данная функция имеет два аргумента. На втором шаге в окне Аргументы функции необходимо задать область поиска (это может быть как одна ячейка, так и диапазон) и указать расположение искомого текста. Результат отображается в ячейке, которая была выделена до вызова данной функции. Важно отметить, что при поиске не учитывается регистр символов, то есть для этой функции строки слово и СлоВо одинаковы.

Функция СуммаВид, о которой рассказывается в данном подразделе, отличается от стандартной функции Excel СУММ тем, что позволяет суммировать данные только видимого диапазона. Иначе говоря, при расчете суммы данная функция игнорирует значения, расположенные в скрытых ячейках. В листинге 2.50 приведен код этой функции.

Листинг 2.50. Функция СуммаВид

Function СуммаВид(Диапазон) As Double

' Просмотр всех ячеек заданного диапазона

For Each Ячейка In Диапазон

' Анализ только видимых ячеек

If Not Ячейка.EntireRow.Hidden And Not _

Ячейка.EntireColumn.Hidden Then

' При расчете учитываются только ячейки _

с численными значениями

If IsNumeric(Ячейка) = True Then

СуммаВид = СуммаВид + Ячейка

End If

End If

Next

End Function

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

Удобный способ суммирования диапазона ячеек реализован в функции Сумма. Она отличается от стандартной функции Excel СУММ тем, что при суммировании курсор может находиться внутри этого же диапазона, но при этом циклическая ошибка не возникнет и соответственно сообщение о ней выводиться не будет. Следует учитывать, что ячейка с функцией в расчетах не участвует. Код функции Сумма выглядит следующим образом (листинг 2.51).

Листинг 2.51. Функция Сумма

Function Сумма(Диапазон, АдресЯчейки) As Double

' Просмотр всех ячеек диапазона

For Each Ячейка In Диапазон

' Проверка, чтобы в суммировании не участвовала _

ячейка с формулой

If АдресЯчейки.Address <> Ячейка.Address Then

' В суммировании участвуют только ячейки _

с численными значениями

If IsNumeric(Ячейка) = True Then

Сумма = Сумма + Ячейка

End If

End If

Next

End Function

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

Процесс начисления комиссионных процентов – один из наиболее популярных процессов в экономической и финансовой деятельности, поэтому любой экономист, менеджер и финансовый работник должен уметь быстро выполнять эту операцию. Функция, которая рассматривается в данном подразделе, поможет решить эту задачу.

Допустим, что организация принимает вклады на следующих условиях: на вклады размером до 4999 руб. начисляется 9 %, на вклады размером от 5000 до 9999 руб. – 11 %, а на вклады размером свыше 10 000 руб. – 15 % (все данные условны). Чтобы быстро рассчитать проценты по вкладам в данном случае, можно воспользоваться функцией dhCalculatePercent, код которой приведен в листинге 2.52.

Листинг 2.52. Функция dhCalculatePercent (вариант 1)

Function dhCalculatePercent(lngSum As Long) As Double

' Процентные ставки (декларация констант)

Const dblRate1 As Double = 0.09

Const dblRate2 As Double = 0.11

Const dblRate3 As Double = 0.15

' Граничные суммы вкладов (декларация констант)

Const intSum1 As Long = 5000

Const intSum2 As Long = 10000

' Возвращаем сумму, умноженную на соответствующую ставку

If lngSum < intSum1 Then

dhCalculatePercent = lngSum * dblRate1

ElseIf lngSum < intSum2 Then

dhCalculatePercent = lngSum * dblRate2

Else

dhCalculatePercent = lngSum * dblRate3

End If

End Function

Эту же функцию можно записать и в таком виде (листинг 2.53).

Листинг 2.53. Функция dhCalculatePercent (вариант 2)

Function dhCalculatePercent(lngSum As Long) As Double

' Процентные ставки (декларация констант)

Const dblRate1 As Double = 0.09

Const dblRate2 As Double = 0.11

Const dblRate3 As Double = 0.15

' Граничные суммы вкладов (декларация констант)

Const intSum1 As Long = 5000

Const intSum2 As Long = 10000

' Возвращаем сумму, умноженную на соответствующую ставку

Select Case lngSum

Case Is < intSum1

dhCalculatePercent = lngSum * dblRate1

Case Is < intSum2

dhCalculatePercent = lngSum * dblRate2

Case Else

dhCalculatePercent = lngSum * dblRate3

End Select

End Function

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

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

Выше мы рассмотрели один из наиболее простых способов расчета процентов в зависимости от суммы вклада (выручки и т. п.). Рассмотрим другой вариант. Предположим, что штатным сотрудникам организации, принимающей вклады, проценты по вкладам начисляются по приведенному в предыдущем подразделе алгоритму. Сторонним же вкладчикам выплачивается 110 % от начисленной суммы. Для решения данной задачи функцию dhCalculatePercent следует написать в таком виде (листинг 2.54).

Листинг 2.54. Функция dhCalculatePercent (вариант 3)

Function dhCalculatePercent(Sales As Long, IsTemporal As Boolean)

As Double

' Процентные ставки (декларация констант)

Const dblRate1 As Double = 0.09

Const dblRate2 As Double = 0.11

Const dblRate3 As Double = 0.15

Const dblAdd As Double = 1.1

' Граничные суммы

Const lngSum1 As Long = 5000

Const lngSum2 As Long = 10000

' Рассчет суммы для выплаты (как обычно)

If Sales < lngSum1 Then

dhCalculatePercent = Sales * dblRate1

ElseIf Sales < lngSum2 Then

dhCalculatePercent = Sales * dblRate2

Else

dhCalculatePercent = Sales * dblRate3

End If

If IsTemporal Then

' Для сторонних вкладчиков – надбавка

dhCalculatePercent = dblAdd * dhCalculatePercent

End If

End Function

Теперь функция dhCalculatePercent будет иметь два аргумента. После выбора в окне Мастер функций данной функции откроется окно, показанное на рис. 2.7.

В данном окне в поле Sales указывается адрес ячейки, на основании которой требуется рассчитать сумму процентов, а в поле IsTemporaL определяется, штатному сотруднику или нет начисляются проценты. Если проценты начисляются штатному сотруднику, то в данном поле следует ввести значение False, а если стороннему вкладчику – следует ввести True (в данном случае проценты будут начислены в размере ПО % от причитающейся суммы).

Рис. 2.7. Аргументы функции dhCalculatePercent

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

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

до 4999 руб. – 9 %;

от 5000 до 9999 руб. -11 %;

свыше 10 000 руб.– 15 %.

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

Для решения поставленной задачи напишем код, представленный в листинге 2.55 (этот код следует поместить в стандартный модуль редактора VBA).

Листинг 2.55. Расчет комиссионного вознаграждения

Function dhCalculateCom(dblSales As Double) As Double

Const dblRate1 = 0.09

Const dblRate2 = 0.11

Const dblRate3 = 0.15

' Расчет комиссионных с продаж (без выслуги) в зависимости _

от суммы

Select Case dblSales

Case 0 To 4999.99: dhCalculateCom = dblSales * dblRate1

Case 5000 To 9999.99: dhCalculateCom = dblSales * dblRate2

Case Is >= 10000: dhCalculateCom = dblSales * dblRate3

End Select

End Function

Function dhCalculateCom2(dblSales As Double, intYears As Double) _

As Double

Const dblRate1 = 0.09

Const dblRate2 = 0.11

Const dblRate3 = 0.15

' Расчет комиссионных с продаж (без учета выслуги лет) _

в зависимости от суммы

Select Case dblSales

Case 0 To 4999.99: dhCalculateCom2 = dblSales * dblRate1

Case 5000 To 9999.99: dhCalculateCom2 = dblSales * dblRate2

Case Is >= 10000: dhCalculateCom2 = dblSales * dblRate3

End Select

' Надбавка за выслугу лет

dhCalculateCom2 = dhCalculateCom2 + _

(dhCalculateCom2 * intYears / 100)

End Function

Sub ComCalculator()

Dim strMessage As String

Dim dblSales As Double

Dim ан As Integer

Calc:

' Отображение окна для ввода данных

dblSales = Val(InputBox(«Сумма реализации:», _

«Расчет комиссионного вознаграждения»))

' Формирование сообщения (с одновременным расчетом _

вознаграждения)

strMessage = «Объем продаж:» & vbTab & Format(dblSales,

«$#,##0») & _

vbCrLf & «Сумма вознаграждения:» & vbTab & _

Format(dhCalculateCom(dblSales), «$#,##0») & _

vbCrLf & vbCrLf & «Считаем дальше?»

' Вывод окна с сообщением (о рассчитанной сумме и вопросом _

о продолжении расчетов)

If MsgBox(strMessage, vbYesNo, _

«Расчет комиссионного вознаграждения») = vbYes Then

' Продолжение расчетов

GoTo Calc

End If

End Sub

В результате написания данного кода будут сформированы две пользовательские функции – dhCalculateCom и dhCalculateCom2 (они будут помещены в категорию Определенные пользователем в окне Мастер функций), а также макрос ComCalculator, доступный в окне выбора макросов. Рассмотрим порядок применения указанных функций и макроса.

Функция dhCalculateCom имеет один аргумент – объем реализации. При выборе функции необходимо указать адрес ячейки, в которой содержится объем реализации по требуемому сотруднику – результат расчета (сумма вознаграждения) отобразится в ячейке, в которой установлен курсор.

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

Для удобства работы рекомендуется привязать макрос ComCalculator к кнопке и поместить ее в какое-либо место интерфейса. После вызова макроса откроется диалоговое окно Расчет комиссионного вознаграждения (название окна и его элементов можно корректировать путем внесения соответствующих изменений в код макроса), гдев поле Сумма реализации следует с клавиатуры ввести сумму, от которой требуется рассчитать объем комиссионного вознаграждения, и нажать кнопку ОК либо клавишу Enter. Результат расчета отобразится в открывшемся информационном окне – в нем будет показана сумма реализации (введенная пользователем) и сумма причитающегося комиссионного вознаграждения. В этом же окне будет сформирован запрос о продолжении расчета либо в выходе из данного режима. При положительном ответе вновь отобразится окно Расчет комиссионного вознаграждения, в котором нужно будет ввести сумму реализации, и т. д.

В данном примере макрос ComCalculator рассчитывает комиссионное вознаграждение без учета выслуги лет сотрудников компании. Для учета выслуги лет следует внести соответствующие изменения в код макроса.