VBA, MS Access MS Access в примерах

Проценты - Несколько полезных функций

Прибавление - Вычитание (по знаку) указанного процента

Public Function esProcentPlusMinus(curSum As Currency, intProcent As Integer, _
                Optional btFixDig As Byte = 2) As Currency
'es 01.07.2011
'Прибавление - Вычитание (по знаку) указанного процента
'с округлением до заданного кол-ва знаков
'--------------------------------------------------------------------
'Аргументы:
'   curSum      = Обрабатываемая сумма
'   intProcent  = Прибавляемый - Вычитаемый процент (по знаку)
'   btFixDig    = Кол-во симв. после запятой в результате 0 - 4  (по умолчанию = 2)
'--------------------------------------------------------------------
'Например:
'   Debug.Print esProcentPlusMinus(200, 100)   '- вернет 400
'   Debug.Print esProcentPlusMinus(100, -20)   '- вернет  80
'--------------------------------------------------------------------
On Error GoTo ProcentMinusErr
    esProcentPlusMinus = CCur(Round(curSum * (intProcent / 100 + 1), btFixDig))
    Exit Function
ProcentMinusErr:
    esProcentPlusMinus = 0: Err.Clear
End Function

Выемка процента из суммы

Public Function esProcentOut(curSum As Currency, intProcent As Integer, Optional bFixDig As Byte = 2) As Currency
'es 01.07.2011
'Выемка процента из суммы
' (т.е. вычесление суммы к которой нужно прибавить указанный процент
' что бы получить исходную), с округлением до заданного кол-ва знаков
'--------------------------------------------------------------------
'Аргументы:
'   curSum      = Обрабатываемая сумма
'   intProcent  = Вынимаемый процент
'   bFixDig     = Кол-во симв. после запятой в результате 0 - 4  (по умолчанию = 2)
'--------------------------------------------------------------------
'Например:
'       Debug.Print esProcentOut(50, 100)  '- вернет 25 (т.к. 25 + 100% = 50)
'--------------------------------------------------------------------
Dim c As Integer
On Error GoTo ProcentOutErr
    c = 100 + intProcent 'получили коэфициент
    esProcentOut = CCur(Round(curSum * 100 / c, bFixDig))
    Exit Function
ProcentOutErr:
    esProcentOut = 0: Err.Clear
End Function

Вычисление процента оплаты (какой процент от общей суммы оплачен)

Public Function esPaidPRC(curSum As Currency, curPaid As Currency, Optional bFixDig As Byte = 2) As Currency
'es 01.07.2011
'Вычисление процента оплаты (какой процент от общей суммы оплачен)
'--------------------------------------------------------------------
'Аргументы:
'   curSum    = Сумма к оплате
'   curPaid   = Сумма ОПЛАЧЕНО
'   bFixDig   = Кол-во симв. после запятой в результате 0 - 4  (по умолчанию = 2)
'--------------------------------------------------------------------
On Error GoTo PaidPRCErr
    esPaidPRC = CCur(Round((curPaid / curSum * 100), bFixDig))
    Exit Function
PaidPRCErr:
    esPaidPRC = 0: Err.Clear
End Function

Недостающий (Превышающий) процент между двумя суммами

Public Function esProcentBT(SumStart As Currency, SumEnd As Currency, Optional frp As Byte = 2) As Currency
'es 01.07.2011
'Недостающий (Превышающий) процент между двумя суммами
'(На сколько процентов нужно увеличить (уменьшить) SumStart что бы получить SumEnd)
'--------------------------------------------------------------------
'Аргументы:
'   SumStart     = Базовая сумма (без процента)
'   SumEnd       = Сумма содержащая вычисляемый процент
'   frp          = Кол-во знаков в дробной части результата (fractional part)
'По умолчанию Возвращает кол-во процентов разницы с округлением до 2-х знаков
'--------------------------------------------------------------------
'Например:
'       Debug.Print esProcentBT(100, 120)  '- вернет; 20
'       Debug.Print esProcentBT(100, 50)   '- вернет -50
'--------------------------------------------------------------------
On Error GoTo ProcentBTErr
    esProcentBT = CCur(Round((SumEnd / SumStart * 100) - 100, frp))
    Exit Function
ProcentBTErr:
    esProcentBT = 0
End Function



Расчёт суммы со скидкой

Public Function ProcentMinus(curSum As Currency, intProcent As Integer, Optional btFixDig As Byte = 2) As Currency
'es 25.04.2017
' Расчёт суммы со скидкой
'--------------------------------------------------------------------
'Аргументы:
'   curSum       = Базовая сумма (без скидки)
'   intProcent   = Cкидка
'   frp          = Кол-во знаков в дробной части результата (по умолчанию = 2)
'--------------------------------------------------------------------
'Например:
'       ?ProcentMinus(100, 10)   - вернет 90
'       ?ProcentMinus(100, 50)   - вернет 50
'--------------------------------------------------------------------
On Error GoTo ProcentMinusErr
    ProcentMinus = CCur(Round(curSum * (1 - intProcent / 100), btFixDig))
    Exit Function
ProcentMinusErr:
    ProcentMinus = 0: Err.Clear
End Function



Расчёт скидки по сумме без и сумме со скидкой

Public Function esDiscountBySum(cSumStart As Currency, cSumDiscount As Currency, Optional frp As Byte = 2) As Currency
'es 25.04.2017
' Расчёт скидки по сумме без и сумме со скидкой
'--------------------------------------------------------------------
'Аргументы:
'   SumStart     = Базовая сумма (без скидки)
'   cSumDiscount = Сумма со скидкой
'   frp          = Кол-во знаков в дробной части результата (по умолчанию = 2)
'--------------------------------------------------------------------
'Например:
'       ?esDiscountBySum(100, 80)   - вернет 20
'       ?esDiscountBySum(100, 50)   - вернет 50
'       ?esDiscountBySum(100, 150)  - вернет -50 (скидка отрицательная = наценка!)
'--------------------------------------------------------------------
On Error GoTo DiscountBySum_Err
    esDiscountBySum = CCur(Round(100 - (cSumDiscount / cSumStart * 100), frp))
    Exit Function
DiscountBySum_Err:
    esDiscountBySum = 0
End Function
Назад ToTop
L.E. 07.03.2019
Рейтинг@Mail.ru