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

направление поиска"

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