Хабр Курсы для всех
РЕКЛАМА
Практикум, Хекслет, SkyPro, авторские курсы — собрали всех и попросили скидки. Осталось выбрать!

В этой статье (в принципе относящейся только к трудящимся в финансовой сфере), я бы хотел привести пример расчета ПСК.
Как обычно законом не покрываются скрытые платежи типа стоимости кассовых операций
или пенёй на досрочную выплату.
Public summa()
Public e()
Public q()
Public m As Integer
Sub Кнопка1_Щелчок()
Dim dates()
Columns("A:A").Select
dates() = Application.Transpose(Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(xlUp)))
Columns("B:B").Select
summa = Application.Transpose(Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(xlUp)))
m = UBound(dates)
'Считаем интервалы БП по графику
ReDim BPall(m)
For k = 3 To m
BPall(k) = dates(k) - dates(k - 1)
Next
'подсчитываем частотность - 1000 это максимальный временной период между платежами в графике
Dim Freq(1000) As Integer
For k = 1 To 1000
Freq(k) = 0
Next
For k = 3 To m
Freq(BPall(k)) = Freq(BPall(k)) + 1
Next
'получаем период с самой наибольшей частотой
mmax = Freq(1)
For k = 1 To 1000
If mmax < Freq(k) Then mmax = Freq(k)
Next k
'берем с наименьшим БП, если одинаковая частотность
bpmin = 1000
For k = 1 To 1000
If mmax = Freq(k) And k < bpmin Then bpmin = k
Next k
'определяем Базовый период
bp = (bpmin)
cbp = Round(365 / bp)
ReDim Days(m)
For k = 2 To m
Days(k) = dates(k) - dates(2)
Next
ReDim e(m)
ReDim q(m)
For k = 2 To m
q(k) = Days(k) \ bp
e(k) = (Days(k) Mod bp) / bp
Next
Dim r As Double
r = 0
Bisect 0, 10000, 0.000000000000001, r
psk = Round(r * cbp, 5)
Cells(3, 7).Value = psk
End Sub
Function F(w As Double) As Double
Dim x As Double
x = 0
For k = 2 To m
x = x + summa(k) / ((1 + e(k) * w) * ((1 + w) ^ q(k)))
Next
F = x
End Function
Sub Bisect(ByVal a As Double, ByVal b As Double, ByVal eps As Double, ByRef r As Double)
Dim c As Double
Dim fa As Double
Dim fb As Double
Dim fc As Double
fa = F(a)
fb = F(b)
Do
c = 0.5 * (a + b)
If Abs(a - b) <= eps Then
r = c
Exit Sub
End If
fc = F(c)
If Abs(fa) <= eps Then
r = a
Exit Sub
End If
If Abs(fb) <= eps Then
r = a
Exit Sub
End If
If (fc > 0 And fb < 0) Or _
(fc < 0 And fb > 0) Then
a = c
fa = F(a)
Else
b = c
fb = F(b)
End If
Loop
End Sub
Полная стоимость кредита(займа) – пример/алгоритм расчета