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

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

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

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

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

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

Const dblRate1 As Double = 0.09

Const dblRate2 As Double = 0.11

Const dblRate3 As Double = 0.15

Const dblAdd As Double = 1.1

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

Const lngSum1 As Long = 5000

Const lngSum2 As Long = 10000

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

If Sales < lngSum1 Then

dhCalculatePercent = Sales * dblRate1

ElseIf Sales < lngSum2 Then

dhCalculatePercent = Sales * dblRate2

Else

dhCalculatePercent = Sales * dblRate3

End If

If IsTemporal Then

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

dhCalculatePercent = dblAdd * dhCalculatePercent

End If

End Function

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

Function dhCalculateCom(dblSales As Double) As Double

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

Dim lngCount As Long

' Проходим по всем ячейкам диапазона 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

End Function

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