Еще о расчете процентов

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

Function dhCalculatePercent(Sales As Long, IsTemporal As Boolean) As Double

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

ConstdblRate1AsDouble= 0.09

ConstdblRate2AsDouble= 0.11

ConstdblRate3AsDouble= 0.15

ConstdblAddAsDouble= 1.1

' Граничные суммы

ConstlngSum1AsLong= 5000

ConstlngSum2AsLong= 10000

' Расчет суммы для выплаты (как обычно)

If Sales < lngSum1 Then

dhCalculatePercent = Sales * dblRate1

ElseIf Sales < lngSum2 Then

dhCalculatePercent = Sales * dblRate2

Else

dhCalculatePercent = Sales * dblRate3

End If

IfIsTemporalThen

' Для сторонних вкладчиков - надбавка

dhCalculatePercent = dblAdd * dhCalculatePercent

End If

End Function

Сводный пример расчета комиссионного вознаграждения

Листинг 2.57.Расчет комиссионного вознаграждения

FunctiondhCalculateCom(dblSalesAsDouble)AsDouble

Const dblRate1 = 0.09

Const dblRate2 = 0.11

Const dblRate3 = 0.15

' Расчет комиссионных с продаж (без выслуги) в зависимости _

от суммы

Select Case dblSales

Case 0 To 4999.99: dhCalculateCom = dblSales * dblRate1

Case 5000 To 9999.99: dhCalculateCom = dblSales * dblRate2

Case Is >= 10000: dhCalculateCom = dblSales * dblRate3

End Select

End Function

Function dhCalculateCom2(dblSales As Double, intYears As Double) _

As Double

Const dblRate1 = 0.09

Const dblRate2 = 0.11

Const dblRate3 = 0.15

' Расчет комиссионных с продаж (без учета выслуги лет) _

в зависимости от суммы

Select Case dblSales

Case 0 To 4999.99: dhCalculateCom2 = dblSales * dblRate1

Case 5000 To 9999.99: dhCalculateCom2 = dblSales * dblRate2

Case Is >= 10000: dhCalculateCom2 = dblSales * dblRate3

End Select

' Надбавка за выслугу лет

dhCalculateCom2 = dhCalculateCom2 + _

(dhCalculateCom2 * intYears / 100)

End Function

Sub ComCalculator()

Dim strMessage As String

Dim dblSales As Double

Dim ан As Integer

Calc:

' Отображение окна для ввода данных

dblSales = Val(InputBox("Сумма реализации:", _

"Расчет комиссионного вознаграждения"))

' Формирование сообщения (с одновременным расчетом _

вознаграждения)

strMessage = "Объем продаж:" & vbTab & Format(dblSales, "$#,##0") & _

vbCrLf & "Сумма вознаграждения:" & vbTab & _

Format(dhCalculateCom(dblSales), "$#,##0") & _

vbCrLf & vbCrLf & "Считаем дальше?"

' Вывод окна с сообщением (о рассчитанной сумме и вопросом _

о продолжении расчетов)

If MsgBox(strMessage, vbYesNo, _

"Расчет комиссионного вознаграждения") = vbYes Then

' Продолжение расчетов

GoTo Calc

End If

End Sub

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

Листинг 2.58.Количество ячеек с определенным значением

Function dhCount(rgn As Range, LowBound As Double, _

UpperBound As Double) As Long

Dim cell As Range

DimlngCountAsLong

' Проходим по всем ячейкам диапазона rgnи подсчитываем значения, _

попадающие в интервал от LowBoundдоUpperBound

For Each cell In rgn

If cell.Value >= LowBound And cell.Value <= UpperBound Then

' Значение попадает в заданный интервал

lngCount = lngCount + 1

End If

Next

dhCount = lngCount

EndFunction