Подсчет количества повторов искомого текста

Листинг 2.51. Функция CoincideCount

Function CoincideCount(Text, Search)

' Проверка правильности входных данных _

(аргумента Search)

If IsArray(Search) = True Then Exit Function

If IsError(Search) = True Then Exit Function

If IsEmpty(Search) = True Then Exit Function

' Просмотр заданного в параметре Text диапазона

For Each iCell In Text

' Анализируются только ячейки, содержащие _

корректные значения

If Not IsError(iCell) Then

' iText - строка для просмотра (в нижнем регистре)

iText = LCase(iCell)

' iSearch - искомое значение (в нижнем регистре)

iSearch = LCase(Search)

' Длина искомой строки

iLen = Len(Search)

' Первый поиск строки iSearch в строке iText _

(этот и последующий поиски производятся без _

учета регистра символов)

iNumber=InStr(iText,iSearch)

WhileiNumber> 0

' Поиск следующего вхождения строки

iNumber = InStr(iNumber + iLen, iText, iSearch)

' Подсчет количества вхождений

CoincideCount = CoincideCount + vbNull

Wend

End If

Next

End Function

Суммирование данных только видимых ячеек

Листинг 2.52.Функция СуммаВид

Function СуммаВид(Диапазон) As Double

' Просмотр всех ячеек заданного диапазона

For Each Ячейка In Диапазон

' Анализ только видимых ячеек

If Not Ячейка.EntireRow.Hidden And Not _

Ячейка.EntireColumn.Hidden Then

' При расчете учитываются только ячейки _

с численными значениями

If IsNumeric(Ячейка) = True Then

СуммаВид = СуммаВид + Ячейка

End If

End If

Next

End Function

При суммировании — курсор внутри диапазона

Листинг 2.53.Функция Сумма

FunctionСумма(Диапазон, АдресЯчейки)AsDouble

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

ForEachЯчейкаInДиапазон

' Проверка, чтобы в суммировании не участвовала _

ячейка с формулой

If АдресЯчейки.Address <> Ячейка.Address Then

' В суммировании участвуют только ячейки _

с численными значениями

If IsNumeric(Ячейка) = True Then

Сумма = Сумма + Ячейка

End If

End If

Next

End Function

Начисление процентов в зависимости от суммы

Листинг 2.54. Функция dhCalculatePercent (вариант 1)

Function dhCalculatePercent(lngSum As Long) As Double

' Процентные ставки (декларация констант)

ConstdblRate1AsDouble= 0.09

ConstdblRate2AsDouble= 0.11

ConstdblRate3AsDouble= 0.15

' Граничные суммы вкладов (декларация констант)

ConstintSum1AsLong= 5000

ConstintSum2AsLong= 10000

' Возвращаем сумму, умноженную на соответствующую ставку

If lngSum < intSum1 Then

dhCalculatePercent = lngSum * dblRate1

ElseIf lngSum < intSum2 Then

dhCalculatePercent = lngSum * dblRate2

Else

dhCalculatePercent = lngSum * dblRate3

End If

End Function

Листинг 2.55. Функция dhCalculatePercent (вариант 2)

Function dhCalculatePercent(lngSum As Long) As Double

' Процентные ставки (декларация констант)

ConstdblRate1AsDouble= 0.09

ConstdblRate2AsDouble= 0.11

ConstdblRate3AsDouble= 0.15

' Граничные суммы вкладов (декларация констант)

ConstintSum1AsLong= 5000

ConstintSum2AsLong= 10000

' Возвращаем сумму, умноженную на соответствующую ставку

Select Case lngSum

Case Is < intSum1

dhCalculatePercent = lngSum * dblRate1

Case Is < intSum2

dhCalculatePercent = lngSum * dblRate2

Case Else

dhCalculatePercent = lngSum * dblRate3

EndSelect

EndFunction