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

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

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

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

Листинг 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)

While iNumber > 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 Сумма(Диапазон, АдресЯчейки) As Double

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

For Each Ячейка 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

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

Const dblRate1 As Double = 0.09

Const dblRate2 As Double = 0.11

Const dblRate3 As Double = 0.15

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

Const intSum1 As Long = 5000

Const intSum2 As Long = 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

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

Const dblRate1 As Double = 0.09

Const dblRate2 As Double = 0.11

Const dblRate3 As Double = 0.15

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

Const intSum1 As Long = 5000

Const intSum2 As Long = 10000

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

Select Case lngSum

Case Is < intSum1

dhCalculatePercent = lngSum * dblRate1

Case Is < intSum2

dhCalculatePercent = lngSum * dblRate2

Case Else

dhCalculatePercent = lngSum * dblRate3

End Select

End Function

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