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

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

Листинг 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.

Листинг 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.

Листинг 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.

Листинг 2.59. Функция dhCalculateAge

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.

Листинг 2.60. Функция dhBooklsSaved

Function dhBookIsSaved() As Boolean

' Если путь файла рабочей книги не задан, то она _

не сохранена (ThisWorkbook.path равняется "")

dhBookIsSaved = ThisWorkbook.path <> ""

End Function

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

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

Листинг 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).

Листинг 2.62. Название месяца

Function dhMonthName(intMonth As Integer) As String

' Возвращение имени месяца по его номеру (intMonth _

является номером элемента в массиве с названиями месяцев)

dhMonthName = Choose(intMonth, «Январь», «Февраль», «Март», _

«Апрель», «Май», «Июнь», «Июль», «Август», «Сентябрь», _

«Октябрь», «Ноябрь», «Декабрь»)

End Function

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

Предположим, что в указанном диапазоне нам нужно сложить не все значения, а только несколько первых (иначе говоря, например, в диапазон входят 10 ячеек, а нам нужно посчитать сумму только первых 5 из них). Для решения этой задачи можно использовать функцию, код которой приведен в листинге 2.63.

Листинг 2.63. Функция dhNSum

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).

Листинг 2.64. Функция dhLastUsedCell

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).

Листинг 2.65. Функция dhLastColUsedCell

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).

Листинг 2.66. Функция dhLastRowUsedCell

Function dhLastRowUsedCell(rgRow As Range) As Variant

' Вывод значения последней непустой ячейки строки

dhLastRowUsedCell = rgRow.Parent.Cells(rgRow.Row, 256). _

End(xlToLeft).Address

End Function

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

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

Листинг 2.67. Функция dhCountSomeCells

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.

Листинг 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).

Листинг 2.69. Преобразование текста в обратном порядке

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.

Листинг 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).

Листинг 2.71. Функция dhSheetOffset

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).

Листинг 2.72. Функция dhSheetOffset2

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.