konstanter Ausdruck

Function cohort(id, dat, rat, _
Optional classes As Integer, Optional ystart, Optional yend)
If IsMissing(ystart) Then ystart = _
Year(Application.WorksheetFunction.Min(dat))
If IsMissing(yend) Then yend = _
Year(Application.WorksheetFunction.Max(dat)) - 1
If classes = 0 Then classes = Application.WorksheetFunction.Max(rat)
Dim obs As Long, k As Long, kn As Long, i As Integer, j As Integer, _
t As Integer
Dim Ni() As Long, Nij() As Long, pij() As Double, newrat As Integer, _
ReDimNij(1 To classes - 1, 0 To classes), Ni(1 To classes)
obs = id.Rows.Count
For k = 1 To obs
'Earliest cohort to whoch observation can belong is from year:
t = Application.Max(ystart, Year(dat(k)))
'Loop through cohorts to which observation k can belong
Do While t  obs Then Exit Do
'Is the issuer in default or not rated
If rat(k) = classes Or rat(k) = 0 Then Exit Do
'Add number of issuers in cohort
Ni(rat(k)) = Ni(rat(k)) + 1
'Determine rating from end of next year (=y+1)
'rating stayed constant
If id(k + 1)  id(k) Or Year(dat(k + 1)) > t + 1 Or k = obs Then
newrat = rat(k)
'rating changed
Else
kn = k + 1
Do While Year(dat(kn + 1) = Year(dat(kn)) And _
id(kn + 1) = id(kn))
If rat(kn) = classes Then Exit Do 'Default is absorbing!_
kn = kn + 1
Loop
newrat = rat(kn)
End If
'Add to number of transitions
Nij(rat(k), newrat) = Nij(rat(k), newrat) + 1
'Exit if observation k cannot belong to cohort of y+1
If newear  rat(k) Then Exit Do
t = t + 1
Loop
Next k
Redimpij(1 To classes - 1, 1 To classes + 1)
'Compute transition frequencies pij = Nij/Ni
For i = 1 To classes - 1
For j = 1 To classes
If Ni(i) > o Then pij(i, j) = Nij(i, j) / Ni(i)
Next j
Next i
'Nr category to the end
For i = 1 To classes - 1
If Ni(i) > 0 Then pij(i, classes + 1) = Nij(i, 0) / Ni(i)
Next i
cohort = pij
End Function