Механизм формул является одним из основных инструментов, используемых в программе Microsoft Excel. В данном разделе мы рассмотрим несколько трюков, которые можно выполнять с использованием формул.
Сложение и вычитание даты и времени
В Excel реализована возможность выполнения арифметических действий с датами. Для этого следует использовать функцию ДАТА. Например, при использовании формулы =ДАТА (2 0 0 4; 4; 11) – ДАТА (2 0 0 4; 3; б) в соответствующей ячейке будет получен результат 36.
Сложение диапазонов разных листов
В процессе работы часто возникают ситуации, когда необходимо суммировать значения ячеек, которые хранятся на разных листах. Для этого в формулу требуется включить названия соответствующих листов. Например, при использовании формулы =СУММ (Лист2: Лист3 !С1: С7) будет рассчитана сумма значений, которые хранятся на листах Лист2 и Лист3 в диапазоне С1:С7.
Накопление итога в ячейке
При проведении различных расчетов часто бывает необходимо сохранять нарастающий итог в той либо иной ячейке. Для достижения подобного эффекта требуется выполнить следующие действия (подразумевается, что нарастающий итог будет накапливаться в ячейке А1, а в ячейку С1 вводятся исходные данные).
1. В ячейку А1 ввести формулу =А1+С1.
2. После того как отобразится окно с сообщением об ошибке, нажать в данном окне кнопку ОК либо Отмена (в данном случае не имеет значения).
3. Войти в режим настройки программы (для этого справа на панели быстрого доступа необходимо нажать кнопку с треугольником и в раскрывающемся списке выбрать пункт Другие команды).
4. Перейти в раздел Формулы.
5. Установить флажок Включить итеративные вычисления, а в поле Предельное число итераций ввести значение 1.
6. Нажать кнопку ОК.
При выполнении данной операции необходимо учитывать следующее: после установки итераций автоматически отключается сообщение об ошибках во всех файлах Excel. Если же итерации убрать, то нарастающий итог в ячейке накапливаться не будет.
Быстрое размножение формул
Для копирования формул, помимо имеющихся в Excel стандартных средств, можно использовать VBA. Например, чтобы скопировать формулу из ячейки А1 в ячейку В2, можно использовать в программе на VBA следующие фрагменты:
Range(«B2»).Formula = Range(«A1»).Formula
Также для этого можно использовать код
Range(«B2»).Value = Range(«A1»).Formula
или
Range(«B2») = Range(«A1»).Formula
Для удобства использования рекомендуется назначить макросу какое-нибудь сочетание клавиш или кнопку с целью быстрого вызова.
Маскировка формул от других пользователей
При необходимости можно замаскировать формулы таким образом, что сторонний пользователь не сможет узнать, какие ячейки участвуют в формуле. Для этого в строке слева от строки формул нужно присвоить имена данным ячейкам, после чего заменить в формуле координаты (адреса) этих ячеек присвоенными именами. Поскольку каждой ячейке может быть присвоено несколько имен (а в строке слева от строки формул показывается только одно имя), то можно сослаться на любое из них, чем еще больше запутать посторонних пользователей. Недостатком данного способа является то, что в раскрывающемся списке строки (которая расположена слева от строки формул) хранится перечень всех имен текущей ячейки, поэтому таким образом можно замаскировать формулу только от начинающих пользователей.
Однако с помощью VBA можно присвоить ячейке имя таким образом, что оно не будет отображаться в списке имен. Для достижения такого эффекта можно использовать следующий код:
Names.Add Name:="Секрет", RefersTo:="=Лист1!$A$5", Visible:=False
При использовании данного кода ячейке А5, которая расположена на листе Лист1, будет присвоено имя Секрет. Это имя не будет отображаться в списке имен, но его можно использовать в формулах вместо адреса ячейки. Например, сумму ячеек А1 и А5 можно задать так: =А1+А5, а можно – с использованием скрытого имени: =А1+Секрет.
Совет
При создании макроса рекомендуется задать сочетание клавиш (например, Ctrl+Shift+A) для его быстрого вызова.
К аналогичному результату приводит использование следующего кода:
Range(«A7»).Name = «Защита»
Range(«Защита»).Name.Visible = False
В данном случае ячейке А7, которая расположена на текущем листе, присвоено скрытое имя Защита.
Быстрое суммирование всех ячеек столбца или строки
Для быстрого суммирования значений всех ячеек какого-либо столбца или строки предназначены специальные формулы. Например, чтобы получить сумму всех ячеек столбца А, нужно воспользоваться формулой =СУММ (А: А), а для суммирования всех ячеек строки 1 – формулой =СУММ (1:1). Если же необходимо получить сумму всех ячеек столбцов А, В и С, то формула будет выглядеть следующим образом: =СУММ (А: С). Для суммирования всех ячеек, которые расположены в строках 1, 2 и 3, применяется следующая формула: =СУММ (1:3).
При суммировании не стоит забывать, что курсор должен быть установлен за пределами суммируемого диапазона – в противном случае Excel выдаст сообщение об ошибке.
Вместо формулы – текущее значение
С помощью несложных приемов можно быстро заменить формулу в ячейке ее текущим значением. Рассмотрим два наиболее популярных способа.
При первом способе необходимо выделить соответствующую ячейку, выполнить команду контекстного меню Правка → Копировать, а затем – команду Правка → Специальная вставка. В результате откроется окно, представленное на рис. 2.6.
В данном окне следует установить переключатель Вставить в положение значения и нажать кнопку ОК. В результате формула в выбранной ячейке будет заменена текущим значением.
Рис. 2.6. Окно Специальная вставка
Второй способ заключается в следующем: необходимо выделить соответствующую ячейку, перейти в режим ее редактирования (не используя при этом строку формул) и последовательно нажать клавиши F9 и Enter. После выполнения указанных действий формула в ячейке будет заменена ее текущим значением.
Повышение точности вычисления формул
В процессе работы с формулами иногда можно заметить неточности в расчетах. Их наличие обусловлено тем, что по умолчанию Excel отображает цифры в ячейках с точностью меньшей, чем при их хранении (например, число 15,434 может отображаться как 15,43). Если в ячейках А1 и А2 хранится одинаковое значение – 15,434, а отображается 15,43, то результат формулы =А1+А2 будет отображен как 30,86, хотя на самом деле он равен 30,868. Иначе говоря, визуально наблюдается неточность в расчетах, хотя в действительности это связано лишь с округлением чисел при их отображении с меньшей точностью.
Решить эту проблему можно двумя способами. Первый из них заключается в том, что в формате ячейки нужно повысить точность отображения чисел. В результате процесс округления будет очевидным для пользователя.
Во втором случае необходимо войти в режим настройки программы (для этого справа на панели быстрого доступа необходимо нажать кнопку с треугольником и в раскрывающемся списке выбрать пункт Другие команды) и в разделе Дополнительно установить флажок Задать точность как на экране, после чего нажать кнопку ОК. В результате Excel будет хранить данные в ячейках с такой же точностью, с которой они отображаются на экране. Иначе говоря, после выполнения данной операции в нашем примере число 15,434 будет преобразовано в 15,43 окончательно.
Первый из предложенных способов более правильный с математической точки зрения, однако второй способ проще и надежнее.
Скрытие сообщений об ошибках при вычислениях
В некоторых случаях сообщение об ошибках может оказаться нежелательным – например, если такое сообщение на самом деле свидетельствует не об ошибке в самих расчетах, а о том, что в ячейку, участвующую в расчетах, просто не были введены необходимые данные. В большинстве подобных ситуаций пользователи вручную удаляют формулы из ячеек. Однако это не совсем удобно – например, после ввода данных в соответствующие ячейки формулы все равно придется восстанавливать. Поэтому для решения таких проблем целесообразнее использовать способ, описание которого приводится ниже.
Для скрытия сообщений об ошибках можно использовать режим условного форматирования. Для этого нужно выделить те ячейки с формулами, результаты вычислений которых не должны отображаться в случае возникновения ошибок, затем в режиме Главная → Стили → Условное форматирование определить формулу вида =ЕОШИБКА (ссылка_на_ячейку), где ссылка_на_ячейку – это ссылка на активную ячейку выделенного диапазона. После этого для данной формулы следует установить белый цвет отображения.
После выполненных действий результаты вычислений с ошибками будут выводиться белым цветом и поэтому не будут видны на экране.
Разработка и применение полезных пользовательских функций
Наряду с формулами функции также являются одним из основных инструментов Microsoft Excel. Функции могут быть как системными (то есть изначально заложенными в программу), так и пользовательскими (пользовательская функция – это функция, созданная пользователем с применением языка VBA).
Далее мы познакомимся с несколькими полезными пользовательскими функциями. При описании применения функций подразумевается, что они выбираются в окне Мастер функций (Формулы → Вставить функцию), однако их можно вводить и в строку формул по обычным правилам Excel.
Объединение данных диапазона
Функция Couple предназначена для объединения всех данных, которые расположены в указанном диапазоне, с добавлением пробелов между ними. Код данной функции выглядит следующим образом (листинг 2.43).
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.
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.
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).
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).
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.
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.
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 приведен код этой функции.
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).
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.
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).
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).
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).
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 рассчитывает комиссионное вознаграждение без учета выслуги лет сотрудников компании. Для учета выслуги лет следует внести соответствующие изменения в код макроса.
Подсчет количества ячеек, содержащих указанные значения
В процессе работы иногда возникает необходимость быстро узнать, какое количество ячеек с указанным значением содержится в том или ином диапазоне. Это бывает нужно, например, чтобы узнать, сколько раз торговая выручка превышала определенную сумму либо находилась в пределах некоторого интервала сумм. Решить эту задачу поможет функция, код которой приведен в листинге 2.56.
Function dhCount(rgn As Range, LowBound As Double, _
UpperBound As Double) As Long
Dim cell As Range
Dim lngCount As Long
' Проходим по всем ячейкам диапазона rgn и подсчитываем значения, _
попадающие в интервал от LowBound до UpperBound
For Each cell In rgn
If cell.Value >= LowBound And cell.Value <= UpperBound
Then
' Значение попадает в заданный интервал
lngCount = lngCount + 1
End If
Next
dhCount = lngCount
End Function
Данная функция содержит три аргумента. Если выбрать ее в окне Мастер функций, то откроется окно, показанное на рис. 2.8.
Рис. 2.8. Аргументы функции dhCount
Разработка и применение полезных пользовательских функций
В данном окне в поле Rgn указывается диапазон, содержимое которого нужно проанализировать, а в полях LowBound и UpperBound – границы значений искомых ячеек диапазона. Например, на рис. 2.8 указано, что необходимо найти общее количество ячеек диапазона B5:F12, значения которых находятся в пределах от 900 до 7000. Результат будет выведен в ячейке, в которой расположен курсор. Если вводить функцию с клавиатуры в строку формул либо в ячейку, то она будет выглядеть следующим образом: =dhCount (B5:F12; 900; 7000).
Подсчет количества видимых ячеек в диапазоне
Как известно, в Excel предусмотрена возможность скрытия строк и столбцов. Поэтому иногда в процессе работы может возникать вопрос: а есть ли в том или ином диапазоне скрытые ячейки? В данном подразделе мы рассмотрим прием, который позволяет быстро посчитать количество видимых ячеек в указанном диапазоне (сравнив его с общим количеством ячеек этого же диапазона, легко определить, есть ли в нем скрытые ячейки).
Для подсчета видимых непустых ячеек диапазона удобно применять пользовательскую функцию dhCountVisibleCells. Для создания данной функции нужно в стандартном модуле редактора VBA написать код, представленный в листинге 2.57.
Function dhCountVisibleCells(rgRange As Range)
Dim lngCount As Long
Dim cell As Range
' Проходим по всему диапазону и подсчитываем непустые _
видимые ячейки
For Each cell In rgRange
' Проверка, есть ли данные в ячейке
If Not IsEmpty(cell) Then
' Проверка, видима ли ячейка
If Not cell.EntireRow.Hidden And Not _
cell.EntireColumn.Hidden Then
' Еще одна видимая ячейка
lngCount = lngCount + 1
End If
End If
Next cell
dhCountVisibleCells = lngCount
End Function
Данная функция имеет один аргумент – диапазон, в котором нужно посчитать видимые ячейки. Результат расчета будет помещен в ячейку, в которой установлен курсор. Функцию можно использовать с помощью формулы, которая записывается в строке формул. Пример такой формулы (в ней может изменяться только анализируемый диапазон) следующий:
=dhCountVisibleCells(A1:Е7)
В данном случае будет подсчитано и помещено в активную ячейку количество видимых ячеек, которые находятся в диапазоне А1:Е7.
Поиск ближайшего понедельника
С помощью несложного трюка можно быстро вычислить требуемый день недели по отношению к заданной дате (например, когда будет первый понедельник после 27.07.2005). В этом нам поможет функция dhGetNextMonday, код которой приведен в листинге 2.58.
Function dhGetNextMonday(datDate As Date) As Date
' Определение даты следующего понедельника (функция Weekday _
возвращает номер дня недели, считая от понедельника, если _
в качестве второго аргумента задавать vbMonday)
If Weekday(datDate, vbMonday) = 1 Then
' Заданная дата и есть понедельник
dhGetNextMonday = datDate
Else
' Расчет даты следующего понедельника
dhGetNextMonday = datDate + 8 – Weekday(datDate,
vbMonday)
End If
End Function
Чтобы получить дату ближайшего понедельника, например, после 27.07.2005, необходимо в окне мастера функций выбрать функцию dhGetNextMonday и в качестве значения аргумента ввести 27.07.2005.
После нажатия Enter в активной ячейке отобразится дата 01.08.2005, то есть ближайший понедельник после 27 июля 2005 года приходится на 1 августа 2005 года. Если воспользоваться строкой формул, то формула будет выглядеть так:
=dhGetNextMonday(«27.07.2005»)
Аналогичным образом можно вычислить даты остальных дней недели.
Если после применения формулы дата не отображается надлежащим образом (например, 3 8545 вместо 12.07.2005), то необходимо установить формат ячейки Дата.
Подсчет количества полных лет
Трюк, который мы сейчас рассмотрим, позволяет быстро посчитать количество целых лет между заданной датой и текущей. В частности, с помощью данного трюка можно определить возраст человека (с округлением до целых лет), зная дату его рождения. В этом нам поможет пользовательская функция dhCalculateAge, код которой приведен в листинге 2.59.
Function dhCalculateAge(datDate As Date) As Long
Dim lngAge As Long
' Находим разность между текущей датой и указанной (лет)
lngAge = DateDiff(«yyyy», datDate, Date)
If DateSerial(Year(datDate) + lngAge, Month(datDate), _
Day(datDate)) > Date Then
' В этом году день рождения еще не наступил
lngAge = lngAge – 1
End If
dhCalculateAge = lngAge
End Function
Если, например, в качестве заданной даты взять 18.08.1972, а сегодняшний день – 28.04.2007, то результатом выполнения данной функции будет число 34. При использовании строки формул в данном случае формула будет выглядеть так:
=dhCalculateAge(«18.08.1972»)
Проверка, была ли сохранена рабочая книга
В процессе работы с новой книгой может возникать вопрос: а была ли уже сохранена текущая книга? Для ответа на него существуют штатные методы (самый простой – воспользоваться командой Сохранить на панели быстрого доступа). Однако можно применить и нестандартный прием; для этого нужно создать пользовательскую функцию, код которой приведен в листинге 2.60.
Function dhBookIsSaved() As Boolean
' Если путь файла рабочей книги не задан, то она _
не сохранена (ThisWorkbook.path равняется "")
dhBookIsSaved = ThisWorkbook.path <> ""
End Function
Данная функция не имеет аргументов. Если после ее запуска в активной ячейке появится значение ИСТИНА, то текущая рабочая книга была ранее сохранена, а если ЛОЖЬ – то книга не сохранялась.
Расчет средневзвешенного значения
Для быстрого расчета средневзвешенного значения можно применить пользовательскую функцию, код которой приведен в листинге 2.61.
Function dhAverageWithWeight(rgWeights As Range, rgValues As
Range) _
As Double
If (rgWeights.Count <> rgValues.Count) Then
' Количество весов не соответствует количеству аргументов
dhAverageWithWeight = 0
Exit Function
End If
Dim i As Integer
Dim dblSum As Double ' Сумма значений
Dim dblSumWeight As Double ' Взвешенная сумма значений
' Вычисление...
For i = 1 To rgWeights.Count
' Взвешенной суммы значений
dblSumWeight = dblSumWeight + rgWeights(i) * rgValues(i)
' Суммы значений
dblSum = dblSum + rgWeights(i)
Next
' Возвращение средневзвешенного значения
dhAverageWithWeight = dblSumWeight / dblSum
End Function
После выбора данной функции откроется окно, в котором следует заполнить поля RgWeights иRgVaLues, после чего нажать кнопку ОК. Результат отобразится в ячейке, в которой установлен курсор.
Преобразование номера месяца в его название
С помощью небольшой пользовательской функции можно быстро получить название месяца на основании его номера. Данную возможность целесообразно использовать при работе с большими объемами информации, когда нужно быстро преобразовать числовые обозначения месяцев в обычные названия. Код функции выглядит следующим образом (листинг 2.62).
Function dhMonthName(intMonth As Integer) As String
' Возвращение имени месяца по его номеру (intMonth _
является номером элемента в массиве с названиями месяцев)
dhMonthName = Choose(intMonth, «Январь», «Февраль», «Март», _
«Апрель», «Май», «Июнь», «Июль», «Август», «Сентябрь», _
«Октябрь», «Ноябрь», «Декабрь»)
End Function
После выбора данной функции необходимо указать номер месяца – в результате соответствующее ему название отобразится в активной ячейке.
Расчет суммы первых значений диапазона
Предположим, что в указанном диапазоне нам нужно сложить не все значения, а только несколько первых (иначе говоря, например, в диапазон входят 10 ячеек, а нам нужно посчитать сумму только первых 5 из них). Для решения этой задачи можно использовать функцию, код которой приведен в листинге 2.63.
Function dhNSum(ByVal intCount As Integer, _
rgValues As Range) As Double
Dim i As Integer
Dim dblSum As Double
If intCount > rgValues.Count Then
' Задано количество элементов большее, чем есть _
в переданном диапазоне
intCount = rgValues.Count
End If
' Расчет суммы первых intCount элементов
For i = 1 To intCount
dblSum = dblSum + rgValues(i)
Next i
' Возврат результата
dhNSum = dblSum
End Function
После выбора данной функции следует указать количество первых значений диапазона, а также сам диапазон (причем можно указать несколько диапазонов – в результате будет рассчитана сумма указанного количества первых значений всех перечисленных диапазонов). Результат вычисления будет показан в активной ячейке.
Поиск последней непустой ячейки диапазона
При работе с большими объемами данных иногда бывает необходимо быстро найти последнюю непустую ячейку какого-либо диапазона (то есть последнюю ячейку, содержащую данные). В этом нам поможет пользовательская функция, для создания которой нужно написать следующий код (листинг 2.64).
Function dhLastUsedCell(rgRange As Range) As Long
Dim lngCell As Long
' Пойдем по диапазону с конца (тогда первая попавшаяся _
заполненная ячейка и будет искомой)
For lngCell = rgRange.Count To 1 Step -1
If Not IsEmpty(rgRange(lngCell)) Then
' Нашли непустую ячейку
dhLastUsedCell = lngCell
Exit Function
End If
Next lngCell
' Непустую ячейку не нашли
dhLastUsedCell = 0
End Function
После выбора данной функции необходимо указать диапазон, который следует проверить, – в результате порядковый номер последней ячейки этого диапазона, которая содержит данные, будет показан в активной ячейке. Следует подчеркнуть, что функция возвращает порядковый номер ячейки диапазона. Если функция не находит заполненную ячейку, то она возвращает 0.
Поиск последней непустой ячейки столбца
Для быстрого поиска последней непустой ячейки столбца удобно применять пользовательскую функцию dhLastColUsedCell. Для ее создания нужно в стандартном модуле редактора VBA написать следующий код (листинг 2.65).
Function dhLastColUsedCell(rgColumn As Range) As Variant
' Вывод значения последней непустой ячейки столбца
dhLastColUsedCell = rgColumn.Parent.Cells(Rows.Count, _
rgColumn.Column).End(xlUp).Value
End Function
Данная функция имеет один аргумент. В качестве аргумента указывается столбец, в котором необходимо найти последнюю непустую ячейку. При этом можно просто указать любую ячейку данного столбца. Содержимое (то есть значение) найденной ячейки будет помещено в ячейку, в которой установлен курсор.
Можно использовать функцию с помощью строки формул. Формула при этом может выглядеть так:
=dhLastColUsedCell(B3)
В данном случае будет найдено и помещено в активную ячейку значение последней непустой ячейки столбца В.
Поиск последней непустой ячейки строки
Чтобы быстро найти последнюю непустую ячейку строки, можно применить пользовательскую функцию dhLastRowUsedCell. Она во многом напоминает рассмотренную выше функцию dhLastColUsedCell. Для создания функции нужно в стандартном модуле редактора VBA написать такой код (листинг 2.66).
Function dhLastRowUsedCell(rgRow As Range) As Variant
' Вывод значения последней непустой ячейки строки
dhLastRowUsedCell = rgRow.Parent.Cells(rgRow.Row, 256). _
End(xlToLeft).Address
End Function
Данная функция использует один аргумент. В качестве аргумента указывается строка, в которой необходимо найти последнюю непустую ячейку. При этом можно просто указать любую ячейку данной строки. Координаты найденной ячейки отобразятся в ячейке, на которой установлен курсор. Порядок использования данной функции такой же, как и рассмотренной выше функции dhLastColUsedCell.
Подсчет количества ячеек в диапазоне, содержащих указанные значения
Трюк, который мы рассмотрим в данном подразделе, позволяет быстро посчитать количество ячеек указанного диапазона, которые расположены в области между заданными значениями. Для решения данной задачи целесообразно использовать функцию dhCountSomeCells, код которой выглядит следующим образом (листинг 2.67).
Function dhCountSomeCells(rgRange As Range, dblMin As Double, _
dblMax As Double) As Long
' Расчет количества ячеек со значениями от dblMin до dblMax _
с использованием стандартной функции CountIf
With Application.WorksheetFunction
dhCountSomeCells = .CountIf(rgRange, «>=» & dblMin) – _
.CountIf(rgRange, «>» & dblMax)
End With
End Function
Данная функция имеет три аргумента: в качестве первого указывается обрабатываемый диапазон, в качестве второго и третьего – соответственно минимальное и максимальное значения диапазона, которые задают область поиска. Количество ячеек, значения которых попадают в указанный интервал, отображается в активной ячейке.
Для использования функции можно применять формулу, пример которой выглядит следующим образом:
=dhCountSomeCells(A1:G15;10;15)
В данном случае будет определено количество ячеек, находящихся в диапазоне A1:G15 и значения которых располагаются в интервале от 10 до 15 (включительно).
Англоязычный текст – заглавными буквами
С помощью несложного трюка можно быстро преобразовать весь англоязычный текст выделенной ячейки в верхний регистр (написать его заглавными буквами). Решить эту задачу поможет пользовательская функция, код которой приведен в листинге 2.68.
Function dhFormatEnglish(strText As String) As String
Dim i As Integer
Dim strCurChar As String * 1
' Анализируется каждый символ строки strText. Каждый символ _
латинского алфавита преобразуется в верхний регистр
For i = 1 To Len(strText)
strCurChar = Mid(strText, i, 1)
' Код латинских строчных символов лежит в пределах _
от 97 до 122
If Asc(strCurChar) >= 97 And Asc(strCurChar) <= 122 Then
' Переводим символ в верхний регистр
dhFormatEnglish = dhFormatEnglish & UCase(strCurChar)
Else
' Просто добавляем символ в выходную строку
dhFormatEnglish = dhFormatEnglish & strCurChar
End If
Next i
End Function
После выбора функции следует указать ячейку, текст которой должен быть написан заглавными буквами. Результат отобразится в активной ячейке. Если преобразуемый текст является «смешанным», то есть содержит и русские, и английские слова, то преобразованы будут только английские слова, а русские останутся без изменений.
Отображение текста «задом наперед»
Трюк, который мы рассмотрим в данном подразделе, вряд ли будет иметь широкое практическое применение, поскольку он носит скорее развлекательный характер. Однако от этого он не становится менее интересным.
Смысл его заключается в том, чтобы быстро «перевернуть» текст выделенной ячейки (например, вместо Мама мыла раму получится умар алым амаМ). Чтобы получить подобный результат, можно применить пользовательскую функцию или специально созданный макрос. Соответствующий код приведен в листинге 2.69 (этот код следует поместить в стандартный модуль редактора VBA).
Function dhReverseText(strText As String) As String
Dim i As Integer
' Переписываем символы из входной строки в выходную _
в обратном порядке
For i = Len(strText) To 1 Step -1
dhReverseText = dhReverseText & Mid(strText, i, 1)
Next i
End Function
Sub ReverseText()
Dim strText As String
' Ввод строки посредством стандартного окна ввода
strText = InputBox(«Введите текст:»)
' Реверсия строки и вывод результата
MsgBox dhReverseText(strText), , strText
End Sub
После того как будет написан данный код, создается пользовательская функция dhReverseText (она будет помещена в категорию Определенные пользователем) и макрос ReverseText (он будет доступен в окне выбора макросов).
После выбора функции следует указать ячейку, текст которой необходимо преобразовать, – результат отобразится в активной ячейке. При выполнении данной операции не стоит забывать, что если ячейка содержит не текст либо пуста, то результатом работы функции будет сообщение об ошибке.
Можно запустить данную функцию, введя ее предварительно в строку формул. В общем случае формула выглядит следующим образом:
=dhReverseText(A4)
Здесь А4 – это адрес ячейки, текст которой требуется преобразовать. После нажатия Enter результат отобразится в активной ячейке.
После запуска макроса ReverseText (его следует выбрать в окне Макрос) откроется диалоговое окно, в котором с клавиатуры нужно ввести требуемый текст и нажать кнопку ОК или клавишу Enter. Результат преобразования текста отобразится в открывшемся информационном окне. Для удобства можно поместить в любое место интерфейса кнопку, к которой привязать макрос ReverseText.
Поиск максимального значения на всех листах книги
В данном подразделе мы рассмотрим, каким образом можно быстро найти максимальное значение указанной ячейки среди всех листов текущей рабочей книги.
Следует отметить, что для решения данной задачи можно воспользоваться штатными средствами программы, а именно – функцией МАКС. Например, с помощью формулы =МАКС (Лист2: Лист7! A3) осуществляется поиск максимального значения ячейки A3 среди рабочих листов с Л ист2 по Л ист7 включительно. Однако данный способ имеет следующий недостаток: при добавлении в книгу новых листов (после Лист7) формулу придется соответствующим образом корректировать.
Поэтому для решения подобных задач целесообразно создать и применять пользовательскую функцию, код которой приведен в листинге 2.70.
Function dhMaxInBook(cell As Range) As Double
Dim sheet As Worksheet
Dim dblMax As Double
Dim dblResult As Double
Dim fFirst As Boolean
fFirst = True
' Расчет максимальных значений во всех листах рабочей книги _
и выбор наибольшего из них
For Each sheet In cell.Parent.Parent.Worksheets
' Расчет максимального значения на листе
dblResult = Application.WorksheetFunction.Max( _
sheet.Range(cell.Address))
If fFirst Then
' Найдено первое значение – его не с чем сравнивать
dblMax = dblResult
fFirst = False
End If
' Выбираем большее из dblMax и dblResult
If dblResult > dblMax Then
dblMax = dblResult
End If
Next sheet
' Возврат результата
dhMaxInBook = dblMax
End Function
Данная функция имеет один аргумент – адрес ячейки, максимальное значение которой следует выбрать из всех рабочих листов текущей книги. При добавлении (удалении) рабочих листов никаких корректировок кода либо формулы выполнять не требуется – в любом случае обрабатываются все доступные рабочие листы текущей книги.
Использование относительных ссылок
Как известно, в Excel ограничена поддержка «трехмерных рабочих книг». Например, если при написании формулы необходимо сослаться на другой рабочий лист в книге, то в формулу нужно включить имя соответствующего рабочего листа. Однако при попытке копирования этой формулы с одного листа на другой ссылка на лист не изменяется, как это происходит в реальной трехмерной рабочей книге. Для решения этой проблемы можно применить пользовательскую функцию dhSheetOf f set, код которой выглядит следующим образом (листинг 2.71).
Function dhSheetOffset(offset As Integer, cell As Range) As
Variant
' Возврат корректного значения ячейки cell листа, смещение _
которого относительно текущего задано переменной offset
dhSheetOffset = Sheets(Application.Caller.Parent.Index _
+ offset).Range(cell.Address)
End Function
Данная функция имеет два аргумента. Первый аргумент – это ссылка на лист; он может быть положительным, нулевым или отрицательным (например, для ссылки на предыдущий лист нужно указать -1). Второй аргумент – это ссылка на конкретную ячейку. Для использования функции можно применять формулу:
=dhSheetOffset(-1;A9)
В данном случае в активной ячейке будет получено значение ячейки А9, расположенной на предыдущем рабочем листе (то есть если текущий лист – Лист2, то будет получено значение ячейки А9 листа Лист1).
При использовании данной функции необходимо учитывать следующее: если рабочий лист содержит листы диаграмм, то при ссылке на ячейку в листе диаграммы будет получено сообщение об ошибке.
При необходимости можно усовершенствовать данную функцию. Ниже приведен код функции dhSheetOf f set2, игнорирующей все листы рабочей книги, которые не являются рабочими (листинг 2.72).
Function dhSheetOffset2(offset As Integer, cell As Range) As
Variant
' Корректировка смещения (чтобы ссылка была на рабочий лист)
Do While TypeName(Sheets(cell.Parent.Index + offset)) _
<> «Worksheet»
If offset > 0 Then
' Пропускаем лист и проходим вперед по книге
offset = offset + 1
Else
' Пропускаем лист и проходим назад по книге
offset = offset – 1
End If
Loop
' Возврат корректного значения ячейки cell листа, смещение _
которого относительно текущего задано переменной offset _
с пропуском листов с диаграммами
dhSheetOffset2 = Sheets(cell.Parent.Index _
+ offset).Range(cell.Address)
End Function
У данной функции аргументы и порядок использования такие же, как и у рассмотренной выше функции dhSheetOffset.
Определение типа данных ячейки
С помощью небольшой пользовательской функции dhCellType можно быстро получить тип данных какой-либо ячейки либо левой верхней ячейки указанного диапазона. Код функции, который набирается в стандартном модуле редактора VBA, представлен в листинге 2.73.
Function dhCellType(rgRange As Range) As String
' Переходим к левой верхней ячейке, если rgRange – диапазон, _
а не одна ячейка
Set rgRange = rgRange.Range(«A1»)
' Определение типа значения в ячейке
Select Case True
Case IsEmpty(rgRange)
' Ячейка пуста
dhCellType = «Пусто»
Case Application.IsText(rgRange)
' В ячейке текст
dhCellType = «Текст»
Case Application.IsLogical(rgRange)
' В ячейке логическое значение (True или False)
dhCellType = «Булево выражение»
Case Application.IsErr(rgRange)
' При вычислении значения в ячейке произошла ошибка
dhCellType = «Ошибка»
Case IsDate(rgRange)
' В ячейке дата
dhCellType = «Дата»
Case InStr(1, rgRange.Text, ":") <> 0
' В ячейке время
dhCellType = «Время»
Case IsNumeric(rgRange)
' В ячейке числовое значение
dhCellType = «Число»
End Select
End Function
Данная функция имеет один аргумент – в его качестве указывается либо адрес конкретной ячейки, либо диапазон (в последнем случае будет определен тип данных левой верхней ячейки этого диапазона). Результат работы функции отображается в активной ячейке. Например, если диапазон или указанная ячейка не содержит данных, то в активной ячейке отобразится значение Пусто; если содержится текстовое выражение, то в активной ячейке появится значение Текст и т. д. в соответствии с кодом функции.
Выделение из текста произвольного элемента
Рассмотрим трюк, с помощью которого можно быстро выделить из текстового содержимого ячейки определенный элемент (текстовый фрагмент, число и т. п.) и поместить его в активную ячейку.
Для реализации данной задачи нам потребуется создать пользовательскую функцию, код которой показан в листинге 2.74 (этот код записывается в стандартном модуле редактора VBA).
Function dhGetTextItem(ByVal strTextIn As String, intItem As _
Integer, strSeparator As String) As String
Dim intStart As Integer ' Позиция начала текущего элемента
Dim intEnd As Integer ' Позиция конца текущего элемента
Dim i As Integer ' Номер текущего элемента
' Проверка корректности номера элемента
If intItem < 1 Then Exit Function
' Убираются лишние пробелы, если разделитель – пробел
If strSepa\rator = " " Then strTextIn =
Application.Trim(strTextIn)
' Разделитель добавляется в конец строки
If Right(strTextIn, Len(strTextIn)) <> strSeparator Then _
strTextIn = strTextIn & strSeparator
' Поиск всех элементов в строке до нужного
For i = 1 To intItem
' Начало элемента (перемещение вперед по строке)
intStart = intEnd + 1
' Конец элемента
intEnd = InStr(intStart, strTextIn, strSeparator)
If (intEnd = 0) Then
' Дошли до конца строки, но элемент не нашли
Exit Function
End If
Next i
' Выделение текста из входной строки
dhGetTextItem = Mid(strTextIn, intStart, intEnd – intStart)
End Function
Данная функция имеет три аргумента: strTextIn, intltemn strSeparator. Аргумент strTextIn – адрес ячейки, из содержимого которой нужно извлечь элемент; intltem – порядковый номер извлекаемого элемента; a strSeparator – символ разделителя между элементами. Соответствующие значения можно как ввести в окне настройки параметров функции, которое открывается после ее выбора в окне Мастер функций, так и использовать для этой цели строку формул. Синтаксис функции выглядит следующим образом (пример):
=dhGetTextItem(A9;3;"-")
В данном случае dhGetTextltem– это название функции, А9 – адрес ячейки с текстом, 3 – порядковый номер извлекаемого элемента, дефис (-) – символ разделителя.
Предположим, что из текста Ночь, улица, фонарь, аптека, который расположен в ячейке В2, нам нужно извлечь слово фонарь. Если воспользоваться строкой формул, то нужно ввести в нее следующую формулу:
=dhGetTextItem(В2;3;",")
В результате слово фонарь отобразится в активной ячейке.
Генератор случайных чисел
В данном подразделе мы научимся быстро заполнять диапазон случайными целыми числами. Данная возможность может быть использована в самых различных сферах деятельности – в частности, ее иногда применяют при разработке развлекательных и игровых программ.
Для выполнения данной операции нам потребуется создать пользовательскую функцию. Ее код представлен в листинге 2.75.
Function dhGetRandomValues() As Variant
Dim intRow As Integer ' Номер текущей строки
Dim intCol As Integer ' Номер текущего столбца
Dim aintOut() As Integer ' Выходной массив (двумерный)
Dim aintValues() As Integer ' Массив с возможными значениями
Dim intMax As Integer ' Последний доступный элемент
массива _ aintValues
Dim i As Integer
ReDim aintOut(1 To Application.Caller.Rows.Count, 1 To _
Application.Caller.Columns.Count)
' Всего нужно чисел...
intMax = Application.Caller.Rows.Count * _
Application.Caller.Columns.Count
ReDim aintValues(1 To intMax)
' Заполнение массива aintValues значениями от 1 до intMax
For i = 1 To intMax
aintValues(i) = i
Next i
' Занесение значений в выходной массив aintOut, в произвольном _
порядке выбирая их из aintValues
Randomize
For intRow = 1 To Application.Caller.Rows.Count
For intCol = 1 To Application.Caller.Columns.Count
' Определение номера элемента из aintValues
i = Rnd * intMax
If i = 0 Then i = 1
' Занесение этого элемента в выходной массив
aintOut(intRow, intCol) = aintValues(i)
' Уменьшение массива aintValues (то есть еще один его _
элемент выбран) – замена выбранного элемента последним _
в массиве
aintValues(i) = aintValues(intMax)
intMax = intMax – 1
Next intCol
Next intRow
' Возвращение массива значений
dhGetRandomValues = aintOut
End Function
Характерной особенностью данной функции является то, что она не имеет аргументов. Пример результата выполнения функции представлен на рис. 2.9.
Рис. 2.9. Случайные числа в диапазоне
Синтаксис созданной функции выглядит так:
=dhGetRandomValues()
Данную формулу нужно применить сразу ко всему предварительно выделенному диапазону – для этого после ввода ее в строку формул следует нажать комбинацию клавиш Ctrl+Shift+Enter. На рис. 2.9 в произвольном порядке разбросано 40 разных чисел, так как в диапазоне 40 ячеек (10 по высоте и 4 по ширине).
Случайные числа – на основании диапазона
Трюк, который мы рассмотрим в данном подразделе, по своей функциональности несколько напоминает предыдущий. Различие заключается в том, что здесь в случайном порядке генерируются числа, содержащиеся в определенном диапазоне (этот диапазон является единственным аргументом рассматриваемой функции). Код функции выглядит следующим образом (листинг 2.76).
Function dhGetRandomValues1(rgSource As Range) As Variant
Dim intRow As Integer ' Номер текущей строки
Dim intCol As Integer ' Номер текущего столбца
Dim avarOut() As Variant ' Выходной массив (двумерный)
Dim avarValues() As Variant ' Массив с возможными значениями
Dim intValCount As Integer ' Количество возможных значений
Dim cell As Range
Dim i As Integer
ReDim avarOut(1 To Application.Caller.Rows.Count, 1 To _
Application.Caller.Columns.Count)
' Всего нужно чисел...
intValCount = rgSource.Rows.Count * rgSource.Columns.Count
ReDim avarValues(1 To intValCount)
' Заполнение массива avarValues значениями из указанного _
диапазона
For Each cell In rgSource
i = i + 1
avarValues(i) = cell.Value
Next cell
' Занесение значений в выходной массив avarOut, в произвольном _
порядке выбирая их из avarValues
Randomize
For intRow = 1 To Application.Caller.Rows.Count
For intCol = 1 To Application.Caller.Columns.Count
' Определение номера элемента из avarValues
i = Rnd * intValCount
If i = 0 Then i = 1
' Занесение этого элемента в выходной массив
avarOut(intRow, intCol) = avarValues(i)
Next intCol
Next intRow
' Возвращение массива значений
dhGetRandomValues1 = avarOut
End Function
Для применения данной функции необходимо иметь диапазон с исходными данными. Синтаксис функции выглядит следующим образом (пример):
=dhGetRandomValues1(A1:C5)
Здесь А1: С5 – диапазон с исходными данными. Как и в предыдущем примере, данная функция применяется ко всему предварительно выделенному диапазону—с помощью сочетания клавиш CtrL+Shift+Enter. После применения функции данные исходного диапазона будут в произвольном порядке разбросаны в новом диапазоне.