2 семестр / vba_2002

Function InRange{rngl, rng2) As Boolean

1Возвращает True, если rngl является подмножеством rng2 InRange = False

If rngl.Parent.Parent.Name = rng2.Parent.Parent.Name Then If rngl.Parent.Name - rng2.Parent.Name Then

If Union(rngl, rng2).Address - rng2.Address Then InRange = True

End If End If

End If End Function

Возможно, функция InRange кажется сложнее, чем того требует С1ггуация, поскольку в коде должна быть реализована проверка принадлежности двух диапазонов одной и той же книге и рабочему листу. Обратите внимание, что в процедуре используется свойство Parent . которое возвращает объект-контейнер заданного объекта. Например, следующее выражение возвращает название листа для объекта r n g l :

rngl.Parent.Name

Представленное далее выражение возвращает имя рабочей книги для объекта rngl : rngl . Parent . Parent . Name

Функция VBA I n t e r s e c t i o n возвращает объект Range, представляющий объединение двух объектов Range. Это объединение содержит общие ячейки двух заданных диапазонов. Если объединение двух диапазонов совпадает со вторым диапазоном, то это означает, что первый диапазон полностью содержится во втором,

Определениетипаданныхячейки

Excel имеет ряд встроенных функций, которые могут помочь определить тип данных, содержащихся в ячейке. Это функции ЕНЕТЕКСТ, ЕЛОГИЧ и ЕОШИБКА. Кроме того, VBA поддерживает функции IsEmpty, IsDate и IsNumeric.

Ниже описана функция CellType. которая принимает аргумент-диапазон и возвращает строку (Пусто, Текст, Булево выражение. Ошибка, Дата, Время и Значение), описывающую тип данных левой верхней ячейки этого диапазона. Такую функцию можно использовать в формуле рабочего листа или вызвать из другой процедуры VBA.

Function CellType(Rng)

'Возвращает тип верхней левой ячейки

'Б диапазоне

Application.Volatile

Set Rng = Rng.Range("Al")

Select Case True

Case IsEmpty{Rng)

CellType = "Пусто"

Case WorksheetFunction.IsText(Rng)

CellType = "Текст"

Case WorksheetFunction.IsLogical(Rng)

CellType - "Булево выражение"

Case WorksheetFunction.IsErr(Rng!

CellType - "Ошибка"

Case IsDate(Rng)

CellType =	"Дата"
Case InStrd, Rng.Text, ":") <> 0
CellType =	"Время"
Case IsNumeric(Rng)
Часть III. VisualBasic^rJpplications^		279

CellType = "Значение" End Select

End Function

Обратите внимание на использование оператора S e t Rng. Функция C e l l T y p e получает аргумент-диапазон произвольного размера, но этот оператор указывает, что функция оперирует только левой верхней ячейкой диапазона.

Чтение и записьдиапазонов

Многие задачи, выполняемые в электронных таблицах, связаны с переносом значений из массива в диапазон ячеек, или из диапазона в массив. Следует отметить, что Excel получает данные издиапазонов значительно быстрее, чем записывает их. ПроцедураWriteReadRange, показаннаявлистинге11.3,демонстрируетотносительнуюскоростьзаписиичтениядиапазона.

Эта процедура создает массив и затем использует циклы F o r - N e x t для записи данного массива в диапазон и считывания данных обратно в массив. С помощью функции Timer вычисляетсявремя,необходимоедлякаждойоперации.

Листинг 11.3. Тестирование скорости выполнения операций чтения и записи в диапазоне

Sub WriteReadRange()

Dim MyArray()

Dim Timel As Date

Dim NumElements As Long, i As Long

Dim WriteTime As String, ReadTime As String

Dim Msg As String

NumElements = 60000

ReDinv MyArray (1 To NumElements)

'Заполнение массива

For i = 1 To NumElements

MyArray(i> = i Next i

' Запись массива в диапазон Timel = Timer

For i = 1 To NumElements

Cellsfi, 1) = MyArrayli) Next i

WriteTime = Format(Timer - Timel, "00:00")

1Считывание диапазона в массив Timel = Timer

For i = 1 To NumElements

	MyArray(i) - Cells(i( 1)
	Next i
	ReadTime = FormatfTimer	- Timel, "00:00")
1	Отображение результатов
	Msg в "Запись: " & WriteTime
	Msg = Msg & vbCrLf
	Msg = Msg & "Чтение: "	& ReadTime
	MsgBox Msg, vbOKOnly, NumElements & " элементов"
End Sub

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

В моей системе для записи массива из 60000 элементов в диапазон потребовалось 15 секунд, и только 4 секунды ушло на то, чтобы занести этот диапазон обратно в массив.

Более эффективный способ записи в диапазон

Пример из предыдущего раздела использует для перемещения содержимого массива в диапазон цикл F o r - N e x t . В данном разделе показан более эффективный способ выполнения этой операции.

Начнем с примера в листинге 11.4, в котором продемонстрирован наиболее очевидный (но не самый эффективный) способ заполнения диапазона. В этом примере для вставки значений в диапазон используется цикл F o r - N e x t .

Листинг11.4.Прямолинейноезаполнениедиапазона

Sub LoopFillRange()

1Заполнение диапазона в цикле

Dim CellsDown As Long, CellsAcross As Integer Dim CurrRow As Long, CurrCol As Integer

Dim StartTiine As Date Dim CurrVal As Long

1Получение размеров

CellsDown = Val(InputBoxt"Сколько ячеек в высоту?"}) CellsAcross = Val(InputBoxf"Сколько ячеек в шипину?"))

'Запись момента начала StartTime = Timer

'Просмотр ячеек и вставка значений CurrVal = 1

Application.ScreenUpdating = False

For CurrRow = 1 To CellsDown

For CurrCol = 1 To CellsAcross

ActiveCell.Offset(CurrRow - 1, _

CurrCol - 1).Value = CurrVal

CurrVal = CurrVal + 1

Next CurrCol

Next CurrRow

' Отображение времени выполнения операции Application.ScreenUpdating = True

MsgBox Format(Timer - StartTime, "00.00") & " seconds" End Sub

Пример в листинге 11.5 демонстрирует самый способ получения того же результата. Программа вставляет значения в массив и использует всего один оператор для переноса содержимого массива в диапазон.

Листинг11.5. Быстрый переносмассивавдиапазон

Sub ArrayFillRange()

1Заполнение диапазона путем переноса массива Dim CellsDown As Long, CellsAcross As Integer

Часть III. Visual Basic for Applications

281

	Dim i As Long,		j As Integer
	Dim StartTime As Date
	Dim TempArrayf)		As Long
	Dim TheRange As Range
	Dim CurrVal	As	Long
1	Получение размеров
	CellsDown = Val(InputBox("Сколько ячеек s высоту?"))
	CellsAcross = Val(InputBox("Сколько ячеек в ширину"))
1	Запись момента		начала
	StartTime = Timer
1	Изменение размерности временного массива
	ReDim TempArray(l To			CellsDown, I To CellsAcross)
1	Определение	диапазона		на рабочем листе
	Set TheRange	-	ActiveCell.Range(Cells(1, 1), _
	Cells{CellsDown,			CellsAcross)}

1Заполнение временного массива CurrVal = О Application.ScreenUpdating = False For i = 1 To CellsDown

	For j = 1 To CellsAcross
	TempArray(i, j) = CurrVal + 1
	CurrVal = CurrVal 4 1
	Next j
	Next i
1	Перенос временного массива на рабочий лист
	TheRange.Value = TempArray
1	Отображение времени выполнения операции
	Application.ScreenUpdating - True
	MsgBox Format(Timer - StartTirre, "00.00") & " секунд"

End Sub

Например, в моей системе на заполнение массива размером 500x256 ячеек (12S000 ячеек) методом никла уходит 202.34 секунды. Метод переноса массива потребовал только 0,77 секунды для получения тех же самых результатов — более чш в 250 раз быстрее! Мораль? Если необходимо переносить большие объемы данных № лист Excel, по возможности избегайте циклов.

Перенос одномерных массивов

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

При переносе одномерного массива диапазон должен быть горизонтальным— т.е. это должна быть строка с несколькими столбцами. Если же необходимо использовать вертикальный диапазон, сначала следует транспонировать массив. Для этого используйте функцию Excel ТРАНСП (TRANSPOSE). В следующем примере 100-элементный массив вставляется в вертикальный диапазон на рабочем листе {hi :А100).

Range(А1:А100}.Value = _

Application.WorksheetFunction.Transpose(MyArray)

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

Перенос диапазона в массив Variant

В настоящем разделе рассматривается еще один способ управления данными Excel в VI! А. В примере, показанном ниже, диапазон ячеек переносится в двухмерный массив V a r i a n t . Затем в окнах сообщений отображаются верхние границы для каждой размерности массива V a r i a n t .

Sub RangeToVariantf}

Dim x As Variant

x = Range("Al:L60Q")

MsgBox UBound(x, 1)

MsgBox UBoundfx, 2) End Sub

В данном примере в первом окне сообщения отображается 600 (количество строк в первоначальном массиве), а во втором окне сообщения — 12 (количество столбцов). Вы увидите, что перенос данных диапазона в массив V a r i a n t происходит за долю секунды.

Следующий пример считывает диапазон в массив V a r i a n t , выполняет простую операцию умножения над каждым элементом массива и перемещает массив V a r i a n t обратно в диапазон.

Sub RangeToVariant2(}

Dim UserRange As Range Dim x As Variant

Dim r As Long, с As Integer

Set UserRange = Range("Al:L600")

'Чтение данных

x= Range("Al:L50")

1	Просмотр массива
	For r = 1 To TJBound{x, 1)
	For с = 1 To UBound{x, 2)
	Multiply by 2
	x(r, c) = x(r, c) * 2
	Next с
	Next r
1	Перемещение массива обратно на рабочий лист
	Range("Al:L50") = х
End	Sub

Данная процедура работает очень быстро.

Выделение максимального значения в диапазоне

Процедура GoToMax в листинге 11.6 переходит к ячейке рабочего листа, содержащей максимальное значение. Процедура определяет максимальное значение в выделенном диапазоне; если выделена одна ячейка, то определяется максимальное значение на всем листе. Для определения адреса необходимой ячейки и ее выделения используется метод Fin.d.

Листинг 11.6. Переход кячейке, содержащей наибольшее значение

Sub GoToMax()

Активизирует ячейку с наибольшим значением

Dim WorkRange as Range

Часть III. VisualBasic forApplications

283

	Dim MaxVal as Double
1	Выход, если диапазон не	выбран
	If TypeName(Selection) <>	"Range" Then Exit Sub

' Если выбрана одна ячейка, поиск по всему листу;

1в противном случае - поиск в Еыделенном диапазоне If Selection.Count = 1 Then

Set Workrange = Cells

Else

Set Workrange = Selection

End If

1 Определение максимального значения MaxVal = Application.Max(Workrange)

1Поиск и выделение ячейки с марссимальным значением On Error Resume Next

Workrange.Find{what:=MaxVal,

After:=Workrange.Range("Al"), _ Lookln:=xlValues, _ LookAt:=xlPart, _ SearchCrder:=xlByRows, _

SearchDirection:=xlNext, MatchCase:=False _ ).Select

If Err <> 0 Then MsgBox "Максимальное значение не найдено: " _ & MaxVal

End Sub

Возможно, вы заметили, что аргументы метода F i n d совпадают с элементами управления в диалоговом окне Excel Найти и заменить.

Выделение всех ячеек с определенным форматированием

Пример данного раздела демонстрирует использование метода F i n d F o r m a t для поиска и выделения всех ячеек на рабочем листе, которые содержат указанное форматирование. Когда эти ячейки выделены, над ними можно выполнить любую операцию — изменить форматирование, удалить и т.п.

Свойство FindFormat впервые появилось в Excel 2002. Следовательно, данная процедура не будет работать в более ранних версиях Excel.

Процедура SelectByForcnat выглядит следующим образом.

Sub	SelectByFormatU
1	Выделяет ячейки на основе их форматирования
1	Используется Excel 2 002 или выше
	If Val(Application.Version) < 10 Then
	MsgBox "Необходима Excel 20 02 или выше."
	Exit Sub
	End If
	Dim FirstCell As Range, FoundCell As Range
	Dim AllCells As Range
284	Глава 11. Примеры и методы программирования на VBA

' Определение форматирования With Application.FindFormat

.Clear

.Interior.Colorlndex = 6 'желтый

.Font.Bold = True End With

1Поиск первой соответствующей ячейки

Set FirstCell = Cells.Find(What:="", SearchFormat:=True)

1Если ячейка не найдена, выход If FirstCell Is Nothing Then

MsgBox "Ячейки указанного формата не найдены.™

Exit Sub

End If

1Инициализация AllCells Set AllCells = FirstCell Set FoundCell = FirstCell

' Просмотр, пока не будет найдена ячейка FirstCell Do

Set FoundCell = Cells.FindNext(After:=FoundCell} Set AllCells = Union(FoundCell, AllCells)

If FoundCell.Address = FirstCell.Address Then Exit Do

Loop

' Выделение найденных ячеек и сообщение пользователю AllCells . Selec t

MsgBox "Найдено ячеек: " & AllCells.Count End Sub

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

Метод Find используется для поиска первой ячейки, соответствующей критерию. Аргумент What метода Find вначале содержит пустую строку, так как поиск определяется форматированием, а не содержимым ячейки. Кроме того, аргумент SearchFormat имеет значение True, поскольку действительно выполняется поиск форматирования, а не значения.

Если указанное форматирование не найдено, пользователь получает сообщение, и программа заканчивает свою работу. В противном случае найденная ячейка присваивается переменной объекта A l l C e l l s (где хранятся все найденные ячейки). Цикл использует метод FindNext для продолжения поиска, который останавливается лишь тогда, когда снова будет найдена первая ячейка. Наконец, все найденные ячейки на рабочем листе выделяются, и пользователь получает сообщение о количестве найденных ячеек.

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

Управление рабочими книгами и листами

Приводимые в этом разделе примеры демонстрируют различные способы использования VBА для управления рабочими книгами и листами.

Часть ///. Visual Basic for Applications

285

Примеры настоящего раздела содержатся на Web-узле издательства.

Сохранение всех рабочих книг

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

Public Sub SaveAllWorkbooks() Dim Book As Workbook

For Each Book In Workbooks

If Book.Path <> "" Then Book.Save Next Book

End Sub

Обратите внимание, как используется свойство P a t h . Если для какой-либо рабочей книги свойство P a t h не задано, то это означает, что файл еще не сохранялся (это новая рабочая книга). Данная процедура игнорирует такие рабочие книги и сохраняет только те из них, у которых свойство P a t h имеет значение.

Сохранение и закрытие всех рабочих книг

Следующая процедура циклически просматривает коллекцию Workbooks. Программа сохраняет и закрывает все рабочие книги.

Sub CloseAllWorkbooksO

Dim Book As Workbook

For Each Book In Workbooks

If Book.Name <> ThisWorkbook.Name Then Book,Close savechanges:=True

End If

Next Book

ThisWorkbook.Close savechanges:= True End Sub

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

Доступ к свойствам рабочей книги

Команда Excel Файл^Свойства отображает диалоговое окно, содержащее информацию об активной рабочей книге. Вы можете обратиться к этим свойствам с помощью VBA. Например, представленная д&чее процедура отображает дату и время последнего сохранения активной рабочей книги.

Sub LastSavedf)

Dim SaveTime As String On Error Resume Next

SaveTime = ActiveWorkbook. _ BuiltinDocumentProperties("Last Save Time"}.Value

If SaveTime = "" Then

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

MsgBox ActiveWorkbook.Name & " не была сохранена."

Else

MsgBox "Сохранено: " & SaveTime, , ActiveWorkbook.Name End If

End Sub

Если рабочая книга не сохранена, то при попытке получить доступ к свойству Last Save Time будет получена ошибка. Оператор OnError пропускает ошибку. Структура If-Then-Else проверяет значение переменной SaveTime и отображает соответствующее сообщение. Если переменная пуста, это означает, что файл не был сохранен. На рис. 11.8 показан пример выполнения этой процедуры.

Рис. 11.8. Отображение даты и времени сохранениярабочей книги

Существует еще несколько встроенных свойств, к которым можно обратиться с помощью VBA, но эти немногочисленные свойства не относятся к опциям Excel. Полный список встроенных свойств вы можете найти в справочной системе.

Синхронизация рабочих листов

Если вы работаете с рабочими книгами, состоящими из нескольких листов, то, вероятно, знаете, что Excel не может "синхронизировать" листы в рабочей книге. Другими словами, не существует автоматического способа сделать гак, чтобы все листы имели одинаковые выделенные диапазоны и верхние левые ячейки. Макрос VBA, показанный ниже, берет за основу активный рабочий лист и выполняет следующие действия со всеми остальными рабочими листами в книге.

•Выделяет тот же диапазон, что и в активном листе.

•Задает ту же левую верхнюю ячейку, что и на активном листе. Нижеприведенлистингданногомакроса.

Sub SynchSheets()

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

1активного листа во всех рабочих листах

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub Dim UserSheet As Worksheet, sht As Worksheet

Dim TopRow As Long, LeftCol As Integer Dim UserSel Аз String

Application.ScreenUpdating = False

1Сохранение текущего листа Set UserSheet = ActiveSheet

1	Сохранение		информации из активного листа
	TopRow =	ActiveWindow.ScrollRow
	LeftCol	=	ActiveWindow.ScrollColumn
	UserSel	=	ActiveWindow.RangeSelection.Address
	Просмотр	рабочих листов
	For Each	sht In ActiveWorkbook.Worksheets

If sht.Visible Then 'пропустить скрытые листы sht.Activate

Range{UserSel}.Select

Часть III. Visual Basic for Applications

287

	ActiveWindow.ScrollRow = TopRow
	ActiveWindow.ScrollColumn = LeftCol
	End If
	Next sht
1	Переход к первоначальной позиции
	UserSheet.Activate
	Application.ScreenUpdating = True
End	Sub

Методы программирования на VBA

Примеры в этом разделе иллюстрирую! часто используемые приемы VBA, которые вы можете использовать в собственных проектах.

Примеры, приведенные в данном разделе, можно найти на Web-узле издательства.

ПереключениезначениясвойстваBoolean

Свойство B o o l e a n — это логическое свойство, принимающее одно из двух значений: True (ИСТИНА) или F a l s e (ЛОЖЬ), Самый простой способ изменить логическое свойство — это использовать оператор Not, как показано в следующем примере, в котором активизируется свойство переноса по словам WrapText в выделенном диапазоне ячеек.

Sub ToggleWrapText()

1 Управляет переносом слов в выделенных ячейках If TypeName(Selection) = "Range" Then Selection.WrapText = Not ActiveCell.WrapText End If

End Sub

Обратите внимание, что за основу взята активная ячейка. Когда диапазон выделен, и значения свойств в разных ячейках неодинаковы (например, в некоторых ячейках шрифт полужирный, а в других — нет), то диапазон считается смешанным, и Excel использует в качестве базового значение свойства активной ячейки. Если, например, активная ячейка имеет полужирный шрифт, то начертание текста в выделенных ячейках при щелчке на кнопке Полужирный на панели инструментов станет обычным. Эта простая процедура имитирует поведение инструмента Excel.

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

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

ActiveWindow.DisplayHeadings = Not _ ActiveWindow.Display-Headings

Для отображения линий сетки на активном листе воспользуйтесь таким синтаксисом:

ActiveWindow.DisplayGridlines = Not _ ActiveWindow.DisplayGridlines

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