MyTetra Share
Делитесь знаниями!
Процент от суммы - Несколько полезных функций
16.03.2019
23:43
Раздел: !Закладки - VBA - Access - msa.polarcom.ru - 14 Преобразование Чисел и Дат

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

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

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



Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования