Анализ эффективности вложений денежных средств в РКО
направление поиска"End
End If
On Error GoTo ErrorFuncFind
i = Row
While Not IsEmpty(Sheet.Cells(i; Column))
If IsDate(Text) Then
Compare = CDate(Sheet.Cells(i; Column))
Compare1 = CDate(Text)
Else
If IsNumeric(Text) Then
Compare = CDbl(Sheet.Cells(i; Column))
Compare1 = CDbl(Text)
Else
Compare = CStr(Sheet.Cells(i; Column))
Compare1 = CStr(Text)
End If
End If
If Compare = Compare1 Then
Поиск = i
Exit Function
End If
i = i + Direction
Wend
Поиск = 0
Exit Function
ErrorFuncFind:
MsgBox "Несовпадение типов данных в вызове" + Chr(13) + "функции Поиск и в искомом столбце." _
+ Chr(13) + Chr(13) + "Данные разных типов в столбце базы" + Chr(13)
End
End Function
Option Explicit
Option Base 1
' ---------------------------- Общая часть -------------------------------------
' внешние параметры
' тип данных для записи информации о бумаге
Type BumRecord
Num As Long ' номер бумаги
DateStart As Date ' дата выпуска
DateEnd As Date 'дата погашения
Volume As Long 'объем выпуска
Present As Boolean
End Type
' тип данных для записи информации о структуре портфеля
Type PortfelRecord
Dates() As Date ' дата покупки
Price() As Single ' цена покупки
Volume() As Long ' количество
StartPos() As Integer ' начальный индекс бумаги в массиве бумаг данной серии
EndPos() As Integer ' конечный индекс бумаги в массиве бумаг данной серии
VolumeAll() As Long ' количество бумаг данной серии в портфеле
End Type
' тип данных для записи информации об индксах портфеля и рынка
Type IndexRecord
Dates As Date
Portfel As Single
Birga As Single
End Type
Const MaxBum = 500 ' максимальное количество бумаг в портфеле одной серии
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
BumInfo(i).Present = True
Else
BumInfo(i).Present = False
End If
Next i
' если выбран анализ эффективной доходности портфеля и рынка
If Analize2 Then
Doh = 0
Volume = 0
Flag = True
For k = 1 To BumNum
If BumInfo(k).Present Then
For i = Portfel.StartPos(k) To Portfel.EndPos(k)
Flag = False
Doh = Doh + (100 / Portfel.Price(k; i) - 1) * 36500 * Portfel.Volume(k; i)
Volume = Volume + Portfel.Volume(k; i) * (BumInfo(k).DateEnd - Portfel.Dates(k; i))
Next i
End If
Next k
If Flag Then
RevIndex = RevIndex - 1
GoTo Anal1
End If
Revenue(RevIndex).Portfel = Doh / Volume
Revenue(RevIndex).Dates = CurDate
Flag = True
Doh = 0
Volume = 0
For k = 1 To BumNum
If BumInfo(k).Present Then
Flag = False
Doh = Doh + (100 / BirgaInfo(k) - 1) * 36500 * BumInfo(k).Volume
Volume = Volume + BumInfo(k).Volume * (BumInfo(k).DateEnd - CurDate)
End If
Next k
If Flag Then
RevIndex = RevIndex - 1
GoTo Anal1
End If
Revenue(RevIndex).Birga = Doh / Volume
End If
Anal1:
' если выбран анализ индекса портфеля и рынка
If Analize1 Then
' определение стоимости портфеля и биржи по средневзвешенным ценам
PortfelPrice = 0
BirgaPrice = 0
For i = 1 To BumNum
PortfelPrice = PortfelPrice + Portfel.VolumeAll(i) * BirgaInfo(i) * 10000
BirgaPrice = BirgaPrice + BumInfo(i).Volume * BirgaInfo(i) * 10000
Next i
' расчет индексов
If CoefIndex <> 1 Then
' поиск остатков за текущий день
k = Поиск(Worksheets("Остаток"); 1; 2; CurDate; 1)
If k <> 0 Then
PortfelPrice = PortfelPrice + Worksheets("Остаток").Cells(k; 2)
End If
' вычисление коэффициента портфеля
If k <> 0 Then
PortfelCoef = (PortfelPrice - Worksheets("Остаток").Cells(k; 3) _
+ Worksheets("Остаток").Cells(k; 4)) / PortfelPricePred
Else
PortfelCoef = PortfelPrice / PortfelPricePred
End If
PortfelPricePred = PortfelPrice
' определение индекса портфеля за текущий день
Index(CoefIndex).Portfel = Index(CoefIndex - 1).Portfel * PortfelCoef
Index(CoefIndex).Dates = CurDate
BirgaCoef = BirgaPrice
k = Поиск(Worksheets("Бумаги"); 2; 2; CurDate; 1)
If k <> 0 Then
BirgaCoef = BirgaCoef - Worksheets("Бумаги").Cells(k; 4)
End If
k = Поиск(Worksheets("Бумаги"); 3; 2; CurDate; 1)
If k <> 0 Then
BirgaCoef = BirgaCoef + Worksheets("Бумаги").Cells(k; 4)
End If
BirgaCoef = BirgaCoef / BirgaPricePred
BirgaPricePred = BirgaPrice
' определение индекса биржи за текущий день
Index(CoefIndex).Birga = Index(CoefIndex - 1).Birga * BirgaCoef
Else
k = Поиск(Worksheets("Остаток"); 1; 2; CurDate; 1)
If k <> 0 Then
PortfelPrice = PortfelPrice + Worksheets("Остаток").Cells(k; 2)
End If
PortfelPricePred = PortfelPrice
BirgaPricePred = BirgaPrice
End If
End If
End Sub
Sub Cancel()
End
End Sub
Приложение № 2.2. Диаграмма сравнения доходности портфеля и рынка.
Приложение № 2.3. Диаграмма сравнения индекса портфеля и рынка.
Приложение № 3. Входные статистические данные.
Приложение 3.1. Информация о бумагах.
| № |
Дата выпуска |
Дата погашения |
Объем выпуска |
|
21019 |
14.11.96 |
13.02.97 |
60 000 000 |
|
21020 |
09.01.97 |
10.04.97 |
65 000 000 |
|
21021 |
13.02.97 |
15.05.97 |
55 000 000 |
|
21022 |
10.04.97 |
10.07.97 |
55 000 000 |
|
21023 |
10.07.97 |
09.10.97 |
40 000 000 |
|
21024 |
18.12.97 |
09.04.98 |
45 000 000 |
|
22002 |
29.08.96 |
27.02.97 |
25 000 000 |
|
22003 |
26.09.96 |
27.03.97 |
30 000 000 |
|
22004 |
24.10.96 |
24.04.97 |
40 000 000 |
|
22005 |
28.11.96 |
29.05.97 |
45 000 000 |
|
22006 |
19.12.96 |
19.06.97 |
90 000 000 |
|
22007 |
30.01.97 |
24.07.97 |
30 000 000 |
|
22008 |
27.02.97 |
28.08.97 |
55 000 000 |
|
22009 |
27.03.97 |
25.09.97 |
55 000 000 |
|
22010 |
24.04.97 |
23.10.97 |
60 000 000 |
|
22011 |
15.05.97 |
13.11.97 |
60 000 000 |
|
22012 |
29.05.97 |
27.11.97 |
60 000 000 |
|
24001 |
20.03.97 |
12.03.98 |
30 000 000 |
|
24002 |
08.05.97 |
07.05.98 |
25 000 000 |
Приложение 3.2. Информация о сделках.
|
Дата |
№ бумаги |
Цена приобр |
Цена продажи |
Кол-во |
|
02.12.96 |
22004 |
92,99 |
62 |
|
|
02.12.96 |
22004 |
93,00 |
340 |
|
|
04.12.96 |
22005 |
77,50 |
6 |
|
|
05.12.96 |
22003 |
85,14 |
5 |
|
|
19.12.96 |
22006 |
80,05 |
300 |
|
|
19.12.96 |
22006 |
80,21 |
500 |
|
|
19.12.96 |
22006 |
80,37 |
259 |
|
|
01.01.97 |
22005 |
92,06 |
7 |
|
|
01.01.97 |
21021 |
0,00 |
1126 |
|
|
01.01.97 |
22005 |
0,00 |
95 |
|
|
01.01.97 |
22008 |
0,00 |
75 |
|
|
01.01.97 |
22009 |
0,00 |
457 |
|
|
01.01.97 |
22008 |
0,00 |
29 |
|
|
01.01.97 |
21020 |
0,00 |
642 |
|
|
01.01.97 |
22004 |
0,00 |
12 |
|
|
01.01.97 |
22006 |
0,00 |
20 |
|
|
01.01.97 |
22009 |
0,00 |
16 |
|
|
01.01.97 |
21020 |
0,00 |
90 |
|
|
01.01.97 |
22006 |
0,00 |
26 |
|
|
01.01.97 |
21020 |
0,00 |
20 |
|
|
01.01.97 |
22004 |
0,00 |
15 |
|
|
01.01.97 |
22006 |
0,00 |
5 |
|
|
01.01.97 |
21021 |
0,00 |
12 |
|
|
01.01.97 |
22006 |
0,00 |
27 |
|
|
01.01.97 |
21020 |
0,00 |
0 |
|
|
01.01.97 |
21021 |
0,00 |
63 |
|
|
01.01.97 |
22004 |
0,00 |
159 |
|
|
01.01.97 |
22005 |
0,00 |
146 |
|
|
01.01.97 |
22009 |
0,00 |
46 |
|
|
01.01.97 |
22007 |
0,00 |
32 |
|
|
01.01.97 |
22008 |
0,00 |
13 |
|
|
01.01.97 |
22006 |
0,00 |
73 |
|
|
01.01.97 |
22006 |
0,00 |
59 |
|
|
01.01.97 |
22006 |
0,00 |
56 |
|
|
01.01.97 |
21020 |
0,00 |
29 |
|
|
01.01.97 |
21021 |
0,00 |
8 |
|
|
01.01.97 |
22005 |
0,00 |
12 |
|
|
01.01.97 |
22006 |
0,00 |
27 |
|
|
01.01.97 |
21021 |
0,00 |
10 |
|
|
01.01.97 |
22008 |
0,00 |
28 |
|
|
01.01.97 |
22008 |
0,00 |
57 |
|
|
01.01.97 |
21021 |
0,00 |
42 |
|
|
01.01.97 |
24001 |
0,00 |
34 |
|
|
01.01.97 |
24001 |
0,00 |
69 |
|
|
01.01.97 |
21021 |
0,00 |
104 |
|
|
09.01.97 |
21020 |
90,93 |
300 |
|
|
09.01.97 |
21020 |
91,03 |
600 |
|
|
09.01.97 |
21020 |
91,24 |
900 |
|
|
09.01.97 |
21020 |
91,35 |
600 |
|
|
09.01.97 |
21020 |
91,50 |
500 |
|
|
10.01.97 |
22004 |
91,54 |
24 |
|
|
13.01.97 |
21020 |
93,65 |
50 |
|
|
14.01.97 |
21020 |
93,22 |
32 |
|
|
15.01.97 |
22005 |
88,51 |
10 |
|
|
17.01.97 |
21020 |
92,50 |
10 |
|
|
28.01.97 |
21020 |
93,40 |
7 |
|
|
31.01.97 |
22007 |
84,19 |
16 |
|
|
31.01.97 |
22007 |
84,20 |
184 |
|
|
06.02.97 |
22004 |
92,80 |
60 |
|
|
10.02.97 |
22006 |
89,00 |
500 |
|
|
13.02.97 |
21021 |
91,20 |
430 |
|
|
13.02.97 |
21021 |
91,30 |
430 |
|
|
13.02.97 |
21021 |
91,33 |
320 |
|
|
17.02.97 |
22005 |
92,25 |
78 |
|
|
17.02.97 |
22007 |
88,42 |
78 |
|
|
19.02.97 |
22005 |
93,00 |
122 |
|
|
19.02.97 |
22003 |
97,55 |
41 |
|
|
19.02.97 |
22007 |
89,39 |
122 |
|
|
20.02.97 |
22005 |
92,60 |
28 |
|
|
25.02.97 |
22005 |
92,01 |
100 |
|
|
25.02.97 |
22005 |
92,03 |
60 |
|
|
25.02.97 |
21020 |
96,00 |
101 |
|
|
26.02.97 |
22004 |
95,10 |
12 |
|
|
26.02.97 |
21021 |
92,50 |
12 |
|
|
27.02.97 |
22008 |
84,04 |
300 |
|
|
27.02.97 |
22008 |
84,10 |
432 |
|
|
27.02.97 |
22008 |
84,22 |
318 |
|
|
27.02.97 |
22008 |
84,09 |
311 |
|
|
27.02.97 |
22008 |
84,22 |
182 |
|
|
27.02.97 |
22008 |
84,42 |
100 |
|
|
28.02.97 |
21021 |
93,23 |
80 |
|
|
03.03.97 |
21020 |
97,30 |
200 |
|
|
03.03.97 |
21021 |
94,00 |
154 |
|
|
03.03.97 |
22006 |
92,50 |
200 |
|
|
04.03.97 |
22006 |
92,40 |
24 |
|
|
04.03.97 |
22006 |
92,52 |
200 |
|
|
04.03.97 |
22006 |
92,53 |
200 |
|
|
06.03.97 |
22006 |
92,63 |
25 |
|
|
06.03.97 |
22004 |
96,45 |
4 |
|
|
06.03.97 |
21020 |
97,53 |
108 |
|
|
12.03.97 |
21020 |
97,70 |
489 |
|
|
13.03.97 |
21020 |
97,50 |
822 |
|
|
13.03.97 |
21021 |
94,00 |
399 |
|
|
17.03.97 |
21021 |
93,67 |
100 |
|
|
19.03.97 |
22003 |
99,19 |
128 |
|
|
19.03.97 |
22003 |
99,20 |
229 |
|
|
20.03.97 |
24001 |
72,00 |
50 |
|
|
20.03.97 |
24001 |
72,15 |
290 |
|
|
21.03.97 |
22005 |
94,20 |
2 |
|
|
21.03.97 |
22005 |
94,25 |
100 |
|
|
24.03.97 |
22005 |
94,25 |
108 |
|
|
24.03.97 |
22005 |
94,39 |
27 |
|
|
24.03.97 |
22005 |
94,40 |
598 |
|
|
24.03.97 |
21020 |
98,40 |
200 |
|
|
25.03.97 |
22006 |
92,10 |
70 |
|
|
25.03.97 |
22005 |
94,05 |
320 |
|
|
25.03.97 |
22003 |
99,78 |
403 |
|
|
26.03.97 |
22006 |
92,00 |
314 |
|
|
26.03.97 |
21021 |
94,45 |
80 |
|
|
26.03.97 |
21020 |
98,10 |
50 |
|
|
28.03.97 |
22005 |
94,15 |
7 |
|
|
28.03.97 |
21021 |
95,10 |
135 |
|
|
28.03.97 |
21021 |
95,19 |
378 |
|
|
28.03.97 |
21021 |
95,20 |
90 |
|
|
28.03.97 |
21020 |
99,07 |
288 |
|
|
28.03.97 |
21020 |
99,01 |
300 |
|
|
31.03.97 |
22006 |
92,92 |
200 |
|
|
31.03.97 |
22006 |
92,93 |
400 |
|
|
31.03.97 |
22006 |
92,94 |
100 |
|
|
31.03.97 |
22005 |
94,50 |
10 |
|
|
31.03.97 |
21020 |
99,10 |
88 |
|
|
31.03.97 |
21020 |
99,11 |
12 |
|