Анализ эффективности вложений денежных средств в РКО

Страница 15

Const DilerConst = 1000900000 ' константа для выборки портфеля дилера

Dim MaxPeriod As Long ' максимальное количество дней для анализа(можно вычислить как последний день анализа-первый день анализа+1)

Dim Portfel As PortfelRecord ' данные о портфеле

Dim BumInfo() As BumRecord ' данные о бумагах

Dim BumNum As Integer ' количество различных серий бумаг

Dim Index() As IndexRecord ' индексы портфеля и рынка

Dim Revenue() As IndexRecord ' доходность к погашению портфеля и рынка

Dim BirgaInfo() As Single ' текущая биржевая информация по каждой серии

Dim CoefIndex As Long ' индекс коэффициента

Dim RevIndex As Long ' индекс доходности

Dim EvalDate As Date ' дата для расчета

Dim StartDate As Date ' начальная дата для постоения индексов

Dim PortfelPricePred; BirgaPricePred As Single

Dim Analize1; Analize2 As Boolean

'------------------------------- Процедура расчета портфеля (главный модуль)-

Sub АнализПортфель()

Dim Sheet As Object

Dim i; Ind As Integer

Dim SumCell As Long

Dim CurDate As Date

Set Sheet = Worksheets("Бумаги")

BumNum = 0

While Sheet.Cells(BumNum + 2; 1) <> Empty

BumNum = BumNum + 1

Wend

With DialogSheets("ДиалогДата")

.EditBoxes(1).Text = "05.02.97"

.EditBoxes(2).Text = "30.05.97"

.EditBoxes(1).InputType = xlDate

.EditBoxes(2).InputType = xlDate

.Show

StartDate = CDate(.EditBoxes(1).Text)

EvalDate = CDate(.EditBoxes(2).Text)

End With

With DialogSheets("ДиалогВыбор")

again:

.Show

Analize1 = False

Analize2 = False

If .CheckBoxes(1).Value = 1 Then Analize1 = True

If .CheckBoxes(2).Value = 1 Then Analize2 = True

If Not Analize1 And Not Analize2 Then

MsgBox "Выберите тип анализа"

GoTo again

End If

End With

MaxPeriod = EvalDate - StartDate + 1

ReDim Index(MaxPeriod)

ReDim Revenue(MaxPeriod)

Index(1).Portfel = 1

Index(1).Birga = 1

Index(1).Dates = StartDate

ReDim BumInfo(BumNum)

ReDim BirgaInfo(BumNum)

For i = 1 To BumNum

With BumInfo(i)

.Num = Sheet.Cells(i + 1; 1)

.DateStart = Sheet.Cells(i + 1; 2)

.DateEnd = Sheet.Cells(i + 1; 3)

.Volume = Sheet.Cells(i + 1; 4)

End With

Next i

ReDim Portfel.Dates(BumNum; MaxBum)

ReDim Portfel.Price(BumNum; MaxBum)

ReDim Portfel.Volume(BumNum; MaxBum)

ReDim Portfel.StartPos(BumNum)

ReDim Portfel.EndPos(BumNum)

ReDim Portfel.VolumeAll(BumNum)

For i = 1 To BumNum

Portfel.StartPos(i) = 1

Portfel.EndPos(i) = 0

Next i

Set Sheet = Worksheets("Сделки")

Call Сортировка(Worksheets("Сделки"); "A2"; "A2"; "B2"; "D2"; _

xlAscending; xlAscending; xlAscending)

i = 2

CoefIndex = 1

RevIndex = 1

CurDate = StartDate

While Sheet.Cells(i; 1) <> Empty And Sheet.Cells(i; 1) <= EvalDate

If Sheet.Cells(i; 2) = DilerConst Then

Ind = ReturnBum(Sheet.Cells(i; 3))

If Not IsEmpty(Sheet.Cells(i; 4)) Then

Portfel.EndPos(Ind) = Portfel.EndPos(Ind) + 1

Portfel.Dates(Ind; Portfel.EndPos(Ind)) = Sheet.Cells(i; 1)

Portfel.Price(Ind; Portfel.EndPos(Ind)) = Sheet.Cells(i; 4)

Portfel.Volume(Ind; Portfel.EndPos(Ind)) = Sheet.Cells(i; 6)

Portfel.VolumeAll(Ind) = Portfel.VolumeAll(Ind) + Sheet.Cells(i; 6)

Else

SumCell = Sheet.Cells(i; 6)

Portfel.VolumeAll(Ind) = Portfel.VolumeAll(Ind) - Sheet.Cells(i; 6)

While SumCell >= Portfel.Volume(Ind; Portfel.StartPos(Ind)) And SumCell > 0

SumCell = SumCell - Portfel.Volume(Ind; Portfel.StartPos(Ind))

Portfel.StartPos(Ind) = Portfel.StartPos(Ind) + 1

Wend

If SumCell < Portfel.Volume(Ind; Portfel.StartPos(Ind)) Then

Portfel.Volume(Ind; Portfel.StartPos(Ind)) = Portfel.Volume(Ind; Portfel.StartPos(Ind)) - SumCell

End If

End If

End If

' в данном месте можео провести анализ на основе данных о портфеле за текущую дату

' дата текущая - это Worksheets("Сделки").cells(i-1;1)

' т.е. анализ за эту текущую дату(доходность к погашению портфеля, индекс, .)

If StartDate <= Sheet.Cells(i; 1) And Sheet.Cells(i; 1) <> CurDate Then

Call Процедура_анализа(Sheet.Cells(i; 1))

CoefIndex = CoefIndex + 1

RevIndex = RevIndex + 1

CurDate = Sheet.Cells(i; 1)

End If

i = i + 1

Wend

If Analize1 Then

Worksheets("РезультатИндекс").Cells(1; 2) = "Портфель"

Worksheets("РезультатИндекс").Cells(1; 3) = "Рынок"

For i = 1 To CoefIndex - 1

Worksheets("РезультатИндекс").Cells(i + 1; 1) = Index(i).Dates

Worksheets("РезультатИндекс").Cells(i + 1; 2) = Index(i).Portfel

Worksheets("РезультатИндекс").Cells(i + 1; 3) = Index(i).Birga

Next i

Charts("ДиаграммаИндекс").ChartWizard Source:=Sheets("РезультатИндекс").Range( _

"A1:C" + CStr(i)); Gallery:=xlLine; Format:=4; PlotBy:=xlColumns; _

CategoryLabels:=1; SeriesLabels:=1; HasLegend:=1; Title:= _

"Сравнение индекса портфеля и рынка"; CategoryTitle:="дата"; ValueTitle:= _

"индекс"; ExtraTitle:=""

Charts("ДиаграммаИндекс").Select

MsgBox "Диаграмма Индекса"

End If

If Analize2 Then

Worksheets("РезультатДоходность").Cells(1; 2) = "Портфель"

Worksheets("РезультатДоходность").Cells(1; 3) = "Рынок"

For i = 1 To RevIndex - 1

Worksheets("РезультатДоходность").Cells(i + 1; 1) = Revenue(i).Dates

Worksheets("РезультатДоходность").Cells(i + 1; 2) = Revenue(i).Portfel

Worksheets("РезультатДоходность").Cells(i + 1; 3) = Revenue(i).Birga

Next i

Charts("ДиаграммаДоходность").ChartWizard Source:=Sheets("РезультатДоходность").Range( _

"A1:C" + CStr(i)); Gallery:=xlLine; Format:=4; PlotBy:=xlColumns; _

CategoryLabels:=1; SeriesLabels:=1; HasLegend:=1; Title:= _

"Сравнение доходности портфеля и рынка"; CategoryTitle:="дата"; ValueTitle:= _

"доходность"; ExtraTitle:=""

Charts("ДиаграммаДоходность").Select

MsgBox "Диаграмма Доходности"

End If

End Sub

'--------------------- функция возвращает индекс бумаги в массиве BumInfo -------------

Function ReturnBum(bum As Long)

Dim i As Integer

For i = 1 To BumNum

If bum = BumInfo(i).Num Then

ReturnBum = i

Exit Function

End If

Next i

MsgBox "Не найдена бумага в списке бумаг. Занести бумагу в лист Бумаги"

End

End Function

'-------------------- Процедура построения индексов портфеля и рынка -----------------

Sub Процедура_анализа(CurDate As Date)

Dim i; k As Long

Dim Sheet As Object

Dim PortfelPrice; BirgaPrice As Single

Dim BirgaCoef; PortfelCoef As Single

Dim Doh; Volume As Single

Dim Flag As Boolean

Set Sheet = Worksheets("Биржа")

' поиск первой строки начала биржевой информации за текущий день

i = Поиск(Worksheets("Биржа"); 1; 2; CurDate; 1)

If i = 0 Then

'MsgBox "Биржевая информация за " + CStr(CDate(CurDate)) + "не найдена"

'End

CoefIndex = CoefIndex - 1

Exit Sub

End If

' занесение биржевой информации за текущий день

If i <> 0 Then

While Sheet.Cells(i; 1) = CurDate

If Sheet.Cells(i; 6) <> Empty Then

BirgaInfo(ReturnBum(Sheet.Cells(i; 2))) = Sheet.Cells(i; 6)

End If

i = i + 1

Wend

End If

' определение по каждой бумаге обращения на бирже

For i = 1 To BumNum

If BumInfo(i).DateStart <= CurDate And CurDate <= BumInfo(i).DateEnd Then