Англоязычный текст — заглавными буквами

Подсчет количества ячеек в диапазоне, содержащих указанные значения

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

Поиск последней непустой ячейки столбца

Поиск последней непустой ячейки диапазона

Расчет суммы первых значений диапазона

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

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

Function dhLastColUsedCell(rgColumn As Range) As Variant

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

dhLastColUsedCell = rgColumn.Parent.Cells(Rows.Count, _

rgColumn.Column).End(xlUp).Value

End Function

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

Function dhLastRowUsedCell(rgRow As Range) As Variant

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

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

End(xlToLeft).Address

End Function

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

Листинг 2.70. Английский текст — в верхнем регистре

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.71. Преобразование текста в обратном порядке

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

Дата добавления: 2015-06-25