Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
VBA в примерах .doc
Скачиваний:
113
Добавлен:
03.05.2015
Размер:
1.33 Mб
Скачать

Отображение текста «задом наперед»

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

Function dhReverseText(strText As String) As String

DimiAsInteger

' Переписываем символы из входной строки в выходную _

в обратном порядке

For i = Len(strText) To 1 Step -1

dhReverseText = dhReverseText & Mid(strText, i, 1)

Next i

End Function

Sub ReverseText()

DimstrTextAsString

' Ввод строки посредством стандартного окна ввода

strText=InputBox("Введите текст:")

' Реверсия строки и вывод результата

MsgBox dhReverseText(strText), , strText

End Sub

Поиск максимального значения на всех листах книги

Листинг 2.72. Поиск максимального значения

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

IffFirstThen

' Найдено первое значение - его не с чем сравнивать

dblMax = dblResult

fFirst = False

End If

' Выбираем большее из dblMaxиdbmResult

If dblResult > dblMax Then

dblMax = dblResult

End If

Next sheet

' Возврат результата

dhMaxInBook = dblMax

EndFunction

Использование относительных ссылок

Листинг 2.73.Функция 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

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

Function dhSheetOffset2(offset As Integer, cell As Range) As Variant

' Корректировка смещения (чтобы ссылка была на рабочий лист)

Do While TypeName(Sheets(cell.Parent.Index + offset)) _

<> "Worksheet"

Ifoffset> 0Then

' Пропускаем лист и проходим вперед по книге

offset=offset+ 1

Else

' Пропускаем лист и проходим назад по книге

offset=offset- 1

EndIf

Loop

' Возврат корректного значения ячейки cellлиста, смещение _

которого относительно текущего задано переменной offset_

с пропуском листов с диаграммами

dhSheetOffset2 =Sheets(cell.Parent.Index_

+ offset).Range(cell.Address)

End Function

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

Листинг 2.75.Тип данных, хранящихся в ячейке

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= "Число"

EndSelect

EndFunction

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]