2 семестр / vba_2002

Function FILLCOLOR(cell) As Integer

1	Возвращает целое число, соответствующее
1	цвету фона	ячейки
	FILLCOLOR =	cell.Rangef"Al").Interior.Colorlndex

End Function

Отображение даты сохранения файла или вывода файла на печать

Рабочая книга Excel содержит несколько встроенных свойств документа, к которым можно получить доступ с помощью свойства B u i l t i n D o c u m e n t P r o p e r t i e s объекта Workbook. Следующая функция возвращает дату и время последнего сохранения рабочей книги.

Function LASTSAVEDO Application.Volatile LAST/SAVED = ThisWorkbook. _

BuiltinDocumentProperties("Last Save Time") End Function

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

Function LASTPRINTED() Application.Volatile LASTPRINTED = ThisWorkbook. _

BuiltinDocumentProperties("Last Print Date") End Function

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

Существует еще несколько встроенных свойств, но Excel их не использует. Например, при попытке получить свойство, указывающее размера файла, будет выведено сообщение об ошибке.

Основы иерархии объектов

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

Объект A p p l i c a t i o n Объект Workbook

Объект Worksheet Объект Range

На языке объектно-ориентированного программирования родителем объекта Range (Диапазон) является объект Worksheet (Рабочий лист), в котором он содержится. Родителем объекта Worksheet является объект Workbook (Рабочая книга), содержащий этот рабочий лист, а родителем объекта Workbook является объект A p p l i c a t i o n (приложение, т.е. Excel).

Как можно применить эту информацию на практике? Проанализируем функцию VBA
SheetName, показанную ниже. Данная функция получает один аргумент (диапазон) и воз-
вращает имя рабочего листа, который содержит указанный диапазон. При этом используется
свойство Paren t объекта Range. Свойство Paren t	возвращает объект, а именно объект,
содержащий объект Range.
Часть HI. VisualBasic forApplications	299

Function SheetName(ref) As String

SheetName = ref . Parent: .Name

End Function

Функция, WorkbookName возвращает название рабочей книги для конкретной ячейки. Обратите внимание, что эта функция использует свойство Parent дважды. Первое свойство Parent возвращает объект Worksheet, а второе свойство Parent возвращает объект Workbook.

Function WorkbookName(ref) As String WorkbookName = ref.Parent.Parent.Name

End Function

Функция AppName, показанная далее, переносит это упражнение на следующий логический уровень, обращаясь к свойству Parent трижды. Эта функция возвращает имя объекта Application для заданной ячейки. Конечно, данная функция всегда будет возвращать значение Microsoft Excel.

Function AppNartiefref} As String

AppName = ref.Parent.Parent.Parent.Name End Function

Подсчет количества ячеек между двумя значениями

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

Function COUNTBETWEEN{InRange, numl, num2) As Long Подсчитывает количество значений между numl и num2 With Application.WorksheetFunction

COUNTBETWEEN = .Count!f(InRange, ">=" & numl) -

.CountIf(InRange, " >" & num2)

End With End Function

Обратите внимание, что эта функция вызывает функцию Excel СЧЕТЕСЛИ (COUNTIF). По существу, функция COUNTBETWEEN является ''упаковкой", которая может упростить формулы.

Нижеприведенпримерформулы,использующейфункциюCOUNTBETWEEN.Формулавозвращает количество ячеек в диапазоне Al:A100, больше или равных 10 и меньше или равных 20.

=COUNTBETWEEN<A1:A100;10;20)

Применяйте эту функцию VBA, чтобы не вводить следующуюдлинную формулу.

*(СЧЕТЕСЛИ(А1:А100; ">=10"))-СЧЕТЕСЛИ(А1:А100; ">=20")}

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

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

Function COUNTVISIBLE(rng)

1Подсчитывает видимые ячейки Dim CellCount As Long

Dim cell As Range Application.Volatile CellCount = 0

Set rng = Intersect(rng.Parent.UsedRange, rng) For Each cell In rng

300	Глава 11. Примеры и методы программирования на VBA

If Not IsEmpty(cell) Then

If Not cell.EntireRow.Hidden And _

Not cell.EntireColumn.Hidden Then _

CellCount = CellCount + 1

End If

Next cell

COUNTVISIBLE = CellCount

End Function

Эта функция циклически просматривает все ячейки диапазона и сначала проверяет, пуста ли ячейка. Если ячейка не пустая, то функция проверят, скрыты ли строка и столбец ячейки. При условии, если либо строка, либо столбец скрыты, переменная C e l l C o u n t увеличивает значение на 1.

Функция COUNTVISIBLE используется при работе с автофильтрами или детализации структуры. В обоих этих случаях часто используются скрытые строки.

	Функция Excel П Р О М Е Ж У Т О Ч Н Ы Е . и т о г и (с первым аргументом 2 или 3) также мо-
С о в в т	жет быть применена для пересчета видимых ячеек в списке автофильтрации. Од-
	нако указанная функция не будет работать должным образом, если ячейки скрыты

*в нефильтрованном списке.

Определение последней непустой ячейки

встолбце или строке

Вданном разделе представлены две важные функции: LASTINCOLUMN возвращает содержимое последней непустой ячейки в столбце, a LASTINROW возвращает содержимое последней непустой ячейки в строке. Каждая функция получает один аргумент — диапазон ячеек. Этот диапазон может представлять собой полный столбец (для функции LASTINCOLIMM) или полную строку (для функции LASTINROW). Если аргумент не является полным столбцом или строкой, функция использует столбец или строку левой верхней ячейки в диапазоне. Например, следующая формула возвращает последнее значение в столбце В:

=LASTINCOLUMN(B5)

Представленная далее формула возвращает последнее значение в строке 7: =LASTINROW(C7:D9)

Функция LASTINCOLUMN

Функция LASTINCOLUMN показана ниже.

Function LASTINCOLUMN(rng As Range) Application.Volatile

Set LastCell = rng.Parent.Cells(Rows.Count, rng.Column) _

.End(xlUp)

LASTINCOLUMN = LastCell.Value

If IsEmpty(LastCell) Then LASTINCOLUMN =

If rng.Parent.Cells(Rows.Count, rng.Column) <> "" Then _ LASTINCOLUMN = rng.Parent.Cells{Rows.Count, rng.Column)

End Function

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

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

Часть ///. Visual Basic forApplications

301

•Оператор Rows.Count возвращает количество строк на рабочем листе. Используем его, а не жестко заданное значение 6:5536, из соображений совместимости (новые версии Excel могут включать больше строк на-рабочем листе).

•rng . Column возвращает номер столбца левой верхней ячейки в аргументе rng.

•Благодаря ссылке r n g . Parent функция работает корректно, даже если аргумент rng ссылается на другой лист или рабочую книгу.

•Метод End (с аргументом xlup) эквивалентен переходу к последней ячейке столбца и нажатию <End> и клавиши со стрелкой "вверх",

•Функция IsEmpty проверяет, пуста пи ячейка. Если ячейка пуста, функция возвращает пустую строку. Без этого оператора пустой ячейке соответствовал бы результат 0.

•Последний оператор If проверяет последнюю ячейку в столбце. Если ячейка не пуста, функция возвращает содержимое этой ячейки.

Функция LASTINROW

Функция LASTINROW представлена ниже. Она во многом напоминает функцию

LASTINCOLUMN.

Function LASTINROW(rng As Range) Application.Volatile

Set LastCell = rng.Parent.Cells(rng.Row, Columns.Count) _

.End(xlToLeft) LASTINROW = LastCell.Value

If IsEmpty(LastCell) Then LASTINROW = ""

If rng.Parent.Cells(rng.Row, Columns.Count) <> •• Then _ LASTINROW = rng.Parent.Cells(rng.Row, Columns.Count)

End Function

Соответствует ли строка шаблону?

Функция ISLIKE довольно проста (и очень полезна). Она возвращает ИСТИНА, если строка соответствует заданному шаблону.

Функция ISLIKE показана далее. Как видно, она представляет собой "оболочку", позволяющую использовать в формулах мощный оператор VBA Like.

Function ISLIKE{text As String, pattern As.String) As Boolean

'Возвращает ИСТИНА, если первый аргумент такой, как второй If text Like pattern Then ISLIKE = True _

Else ISLIKE = False End Function

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

t e x t — тестовая строка или ссылка на ячейку, содержащую текстовую строку;

p a t t e r n — строка, содержащая групповые символы согласно следующему списку.

Сим вол(ы) в шаблоне		Соответствует в тексте
?		Любой отдельный символ
*		Ноль и больше символов
#		Любая отдельная цифра (0-9)
[список_символов]	Любой отдельный символ из список_символов
[! список^символов]	Любой отдельный символ, не принадлежащий
	список_символов
Ж		Глава 11. Примеры и методы программирования на VBA

Представленная ниже формула возвращает ИСТИНА, так как * соответствует любому количеству символов. Она возвращает ИСТИНА, если первый аргумент — любой текст, начинающийся с д:

= I S L I K E ( " g u i t a r " ; "д*")

Следующая формула возвращает ИСТИНА, так как ? соответствует любому отдельному символу. Если бы первым аргументом функции был "Unit 12", то функция возвращала бы ЛОЖЬ:

=ISLIKE("Unitl"; "Unit?")

Показанная далее формула возвращает ИСТИНА, так как первый аргумент является одним из символов списка во втором аргументе:

=ISLIKE("a"; " ( a e i o u l " )

Следующая формула возвращает ИСТИНА, если ячейка Al содержит один из символов: а, е, i, о, u. A, E, I, О, и. При использовании функции UPPER в аргументе функция становится не чувствительной к регистру:

=ISLIKE(UPPER(A1)I UPPER!"[aeiou]"))

Представленная далее формула возвращает ИСТИНА, если в ячейке Al находится значение, начинающееся с 1 и состоящее ровно из трех цифр (т.е. любое целое число от 100 до 199): =ISLIKE(A1; "1##")

Извлечение из строки п-го элемента

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

123-456-789-0133-8844

Представленная далее формула, например, возвращает 0133, т.е. четвертый элемент в строке. Дефис (-) используется в строке как разделитель:

=ExtractElement("123-456-789-0133-8844",4,"-")

Функция ExtractElement имеет три аргумента:

Txt — текстовая строка, из которой извлекается подстрока. Это может быть символькая строка или ссылка на ячейку:

п — целое число, представляюшее элемент для извлечения; Separator — отдельный символ, используемый как разделитель.

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

Ниже приведен код VBA функции ExtractElement.

Function ExtractElement(Txt, n, Separator)	As String
' Возвращает п-й элемент текстовой строки,	где

'элементы разделены указанным символом-разделителем.

Dim Txtl As String, TempElenient As String

Dim ElementCount As Integer, i As Integer

ЧастьIII. VisualBasicforApplications

303

Txtl - Txt

'Если разделитель - пробел, убрать лишние пробелы

If Separator = Chr(32) Then Txtl • Application.Trim{Txtl)

1Добавление разделителя в конец строки

If Right{Txtl, Len(Txtl)) <> separator Then _ Txtl = Txtl & Separator

' Инициализация

ElementCount = 0 TempEleraent = ""

1Извлечение каждого элемента For i = 1 To Len(Txtl)

If Mid(Txtl, i, 1) = Separator Then

ElementCount = ElementCount + 1

If ElenientCount = n Then

•n-й символ найден, выход

ExtractElement = TempElement

Exit Function

Else

TempElement = ""

End If

Else

TempElement = TempEleaient & Mid (Txtl, i, 1)

End If

Next i

ExtractElement=""

End Function

Множественная функция

В этом примере рассматривается прием, который используется в такой ситуации, когда необходимо, чтобы одна функция рабочего листа работала, как несколько функцийНапример, ниже показан код VBA для специальной функции с названием S t a t F u n c t i o n . Эта функция имеет два аргумента: диапазон (rncf) и операция (ор). В зависимости от значения ор функция возвращает значение, вычисленное с помошью одной из следующих функций Excel: СРЗНАЧ (AVERAGE), СЧЕТ (COUNT), МАКС (МАХ), МЕДИАНА (MEDIAN), МИН (MIN), МОДА (MODE), СТАНДОТКЛОН (STDEV), СУММ (SUM) ИЛИ ДИСП (VAR).

Например, вы можете использовать эту функцию на рабочем листе следующим образом: =STATFUNCTION(В1гВ24;А24)

Результат формулы зависит от содержимого ячейки А24, которое представлено строкой: СРЗНАЧ, СЧЕТ, МАКС и Т.Д. Вы можете применить этот прием в других типах функций.

Function STATFUNCTION(rng, op) Select Case UCase(op)

Case "SUM"

STATFUNCTION = WorksheetFunction.Sumfrng) Case "AVERAGE"

STATFUNCTION = WorksheetFunction.Average(rng) Case "MEDIAN"

		STATFUNCTION = WorksheetFunction.Median(rng)
	Case	"MODE"
		STATFUNCTION = WorksheetFunction.Mode(rng)
	Case	"COUNT"
304		Глава 11. Примеры и методы программирования на VBA

STATFUNCTION = WorksheetFunction.Count(rng)

Case "MAX"

STATFUNCTION = WorksheetFunction.Max(rng)

Case "MIN"

STATFUNCTION = WorksheetFunction.Min(rng)

Case "VAR"

STATFUNCTION = WorksheetFunction.Var(rng)

Case "STDEV"

STATFUNCTION = WorksheetFunction.StDev(rng)

Case Else

STATFUNCTION = CVErr(xlErrNA)

End Select

End Function

Функция SHEETOFFSET: версия 1

Вероятно, вы знаете, что в Excel ограничена поддержка "трехмерных рабочих книг". Например, если требуется сослаться на другой рабочий лист в книге, включите в формулу имя рабочего листа. Данная проблема невелика до тех пор, пока вы не попытаетесь скопировать формулу из одного листа на другой. Скопированные формулы продолжают ссылаться на первоначальное имя рабочего листа, и ссылки на листы не изменяются, как это реализуется н реальной трехмерной рабочей книге.

Пример, рассмотренный в этом разделе, представляет функцию VBA (под названием SHEETOFFSET), которая позволяет обращаться к листам относительным способом. Напричер, вы можете сослаться на ячейку А1 предыдущего рабочего листа с помощью формулы =SHEETOFFSET(-1;А1)

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

Ниже приведен код VBA функции SHEETOFFSET.

Function SHEETOFFSET<offset, Kef) Application.Volatile

SHEETOFFSET = Sheets(Application.Caller.Parent.Index _ + offset).Range(Ref.Address)

End Function

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

Функция SHEETOFFSET: версия 2

	Ниже показана пересмотренная функция SHEETOFFSET. Эта версия несколько более сложная,
но в ней исключается проблема, описанная в предыдущем разделе. Данная версия SHEETOFFSET
игнорирует любые листы рабочей книги, которые не являются рабочими.
Function SHEETOFFSET2{offset,		Ref)
	Dim WBook As Workbook
	Dim WksCount As Integer,	i As Integer
	Dim CallerSheet As String, CallerIndex As Integer
	Application.Volatile
1	Создание массива, состоящего только из рабочих листов
Часть ///. Visual Basic forApplications			305

Set WBook = Application.Caller.Parent.Parent

Dim Wks() As Worksheet

WksCount = 0

For i = 1 To WBook.Sheets.Count

If TypeName(WBook.Sheets(i)) = "Worksheet" Then

WksCount = WkaCount + 1

ReDim Preserve Wks(l To WksCount)

Set Wks{WksCount} = WBook.Sheets(i)

End If

Next i

1Определение позиции листа, вызывающего функцию CallerSheet = Application.Caller.Parent.Name For i = 1 To UBound(Wks)

If CallerSheet = Wks(i).Name Then Callerlndex - i

Next i

'Получение значения

SHEETOFFSET2 = Wks(Callerlndex + _

offset).RangefHef.Address)

End Function

Возвращение максимального значения всехрабочихлистов

Если необходимо определить максимальное значение в ячейке В1 в нескольких рабочих листах, то используется формула =МАКС(Лист!:Лист4!В1)

Эта формула возвращает максимальное значение ячейки В1 для листов Лист1, Лист4 и всех листов между ними.

Что же произойдет, если добавить после листа Лист4 новый лист (Лист5)? Формула не будет автоматически изменена, поэтому ее необходимо отредактировать, чтобы включить ссылку на новый лист:

=МАХ{Лист1:ЛИСТ5!В1)

Функция MAXALLSHEETS, показанная ниже, получает аргумент(одна ячейка) и возвращает максимальное значение в этой ячейке во всех рабочих листах данной книги. Например, следующая формулавозвращает максимальное значение в ячейке В1 для всех листов книги:

=MAXALLSHEETS{В1)

Придобавленииновоголистаредактироватьформулунеобязательно.

Function MAXALLSHEETS(cell)

Dim MaxVal As Double

Dim Addr As		String
Dim wksht As		Object
Application.Volatile
Addr =	cell.Range("Al").Address
MaxVal	= -9.9E+307
For Each Wksht In cell.Parent.Parent.Worksheets
If Wksht.Name = cell.Parent.Name And _
Addr -		Application.Caller.Address Then
'	избежание циклической ссылки
Else
306		Глава 11. Примеры и методы программирования на VBA

If IsNumeric{Wksht.Range(Addr)J Then

If Wksht.Range(Addr) > MaxVal Then _

MaxVal = Wksht.Range<Addr).Value End If

End If Next Wksht

If MaxVal = -9.9E+307 Then MaxVal = 0 MAXALLSHEETS = MaxVal

End Function

Оператор For Each использует для доступа к рабочей книге выражение cell.Parent.Parent.Worksheets

Родителем ячейки является рабочий лист, родителем рабочего листа — рабочая книга. Следовательно, цикл For Each проходит по всем рабочим листам в книге. Первый оператор If внутри цикла выполняет проверку, содержит ли ячейка, которая проверяется в данный момент, функцию. Если это так, то ячейка игнорируется во избежание циклической ссылки.

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

Возвращение массива случайных целых чисел без повторов

Функция RANDOM INTEGERS, представленная в этом разделе, возвращает массив целых чисел без повторов. Она предназначена для применения в формуле массива в нескольких ячейках. На рис. П.П показан рабочий лист, использующий в диапазоне ячеек Al:D10 формулу

{=RANDOMINTEGERS()}

Данная формула введена в весь диапазон с помощью комбинации клавиш <Ctrl+Shift+Ent.;r>. Она возвращает массив целых чисел без повторов, упорядоченных произвольным образом. Так как формулу содержат 40 ячеек, целые числа указываются в диапазоне от 1 до 40.

Рис. 11.11. Формула массива генерирует последовательные целые числа без повторов. Все они упорядоченыпроизвольнымобразом

Часть Ш. Visual Basic forApplications

307

Ниже приведен код функции RANDOMINTEGERS.

Function RANDOMINTEGERS() Dim FuncRange As Range

Dim V() As Variant, ValArray(} As Variant Dim CellCounc As Double

Dim i As Integer, j As Integer

Dim r As Integer, с As Integer

Dim Tempi As Variant, Temp2 Аи Variant Dim RCount As Integer, CCount As Integer Randomize

1Создание объекта Range

Set FuncRange = Application.Caller

'Возвращение ошибки, если диапазон FuncRange слишком большой CellCount = FuncRange.Count

If CellCount > 1000 Then

RANDOMINTEGERS = CVErr(xlErrNA)

Exit Function

End If

'	Присваивание переменных
	RCount = FuncRange.Rows.Count
	CCount = FuncRange.Columns.Count
	ReDim V(l To RCount, 1 To CCount)
	ReDim ValArrayd To 2, 1 To CellCount)
1	Заполнение массива произвольными номерами
'	и последовательными целыми числами
	For i = 1 То CellCount
	ValArrayd, i) = Rnd
	ValArray<2, i) = i
	Next i

1Сортировка массива ValArray no произвольным числам For i = 1 To CellCount

For j = i + 1 To CellCount

If ValArrayd, i) > ValArrayd, j) Then Tempi = ValArrayd, j)

Temp2 = ValArray(2, j) ValArrayd, j) = ValArrayd, i) ValArray(2, j) = ValArray(2, i) ValArrayd, i) = Tempi ValArray{2, i) = Temp2

End If Next j

Next i

1Занесение произвольных значений в массив V 1 = 0

For r = 1 То RCount

For с = 1 То CCount i = i + 1

V(r, с) = ValArray(2, i) Next с

Next r RANDOMINTEGERS = V

End Function

Глава 11. Примерыиметоды программированияна VBA