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

xlThin

Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlTop).Weight = xlThin

Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlBottom).Weight =

xlThin

Range(Cells(7; 1); Cells(Num - 1; 17)).BorderAround Weight:=xlMedium

Cells(Num; 1) = "Итого"

Cells(Num; 1).Font.Bold = True

Cells(Num; 1).HorizontalAlignment = xlCenter

Cells(Num; 14) = mas(1) / mas(3)

Cells(Num; 15) = mas(1) / mas(3) / 0,85

Cells(Num; 16) = mas(2) / mas(3)

Cells(Num; 16).Font.Bold = True

Cells(Num; 17) = mas(2) / mas(3) / 0,85

Range(Cells(Num; 14); Cells(Num; 17)).NumberFormat = "0,00"

For i = 1 To 3

mas(i) = 0

Next i

For i = 7 To Num - 1

mas(1) = mas(1) + Cells(i; 6)

mas(2) = mas(2) + Cells(i; 7)

mas(3) = mas(3) + Cells(i; 9)

Next

Cells(Num; 6) = mas(1)

Cells(Num; 6).NumberFormat = "# ##0"

Cells(Num; 7) = mas(2)

Cells(Num; 9) = mas(3)

Cells(Num; 9).NumberFormat = "# ##0"

Cells(Num; 8) = mas(3) / mas(1) * 100

Cells(Num; 8).NumberFormat = "0,00"

Cells(Num; 7).Font.Bold = True

Cells(Num; 9).Font.Bold = True

Range(Cells(Num; 1); Cells(Num; 17)).BorderAround Weight:=xlMedium

Range(Cells(Num; 1); Cells(Num; 17)).Interior.ColorIndex = 15

If DialogPrint("Биржевая Информация"; 1) Then Exit Sub

End Sub

'-------------------------------- Дата -----------------------------

Sub DateChange()

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

.EditBoxes.Text = CurDate

.EditBoxes.InputType = 1

.Show

CurDate = Worksheets("Врем").Cells(1; 4)

If Button = False Then

CurDate = Date

Worksheets("Врем").Cells(1; 4) = CurDate

MsgBox "Дата восстановлена"

Else

If IsDate(.EditBoxes.Text) Then

CurDate = .EditBoxes.Text

MsgBox "Дата изменена"

Worksheets("Врем").Cells(1; 4) = CurDate

Exit Sub

End If

MsgBox "Ошибка при вводе даты"

End If

End With

End Sub

'-------------------------------- Формирование текущей таблицы бумаг --

--

Sub FormBum()

Dim L As Object

Dim i; k As Integer

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

CurDate = Worksheets("Врем").Cells(1; 4)

i = 2

k = 1

While L.Cells(i; 1) <> Empty

If L.Cells(i; 2) = CurDate Then

Worksheets("Врем").Cells(k; 1) = L.Cells(i; 1)

k = k + 1

End If

i = i + 1

Wend

Worksheets("Врем").Cells(1; 2) = k - 1

Set L = Worksheets("Клиенты")

i = 1

While L.Cells(i; 1) <> Empty

i = i + 1

Wend

Worksheets("Врем").Cells(1; 3) = i - 2

End Sub

' ------------------------------- Остатки на бирже --------------------

Sub EditOstBirga(CliNum As Long)

Dim ComBirga; sum; OstBegin As Double

Dim DoFlag As Boolean

Dim Sheet; Sheet1 As Object

Dim i; k; RowNum As Long

Set Sheet = Worksheets("ОстаткиБиржа")

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

CurDate = Worksheets("Врем").Cells(1; 4)

ComBirga = Worksheets("Инфо").Cells(1; 2)

Sheet.Range("B2").Sort Key1:=Sheet.Range("B2"); Order1:=xlAscending;

_

Key2:=Sheet.Range("A2");

Order2:=xlDescending; _

Header:=xlYes; OrderCustom:=1; _

MatchCase:=False; Orientation:=xlTopToBottom

OstBegin = 0

RowNum = 0

k = 2

DoFlag = True

Do While Sheet.Cells(k; 1) <> Empty

If Sheet.Cells(k; 2) = CliNum And DoFlag Then

If Sheet.Cells(k; 1) < CurDate Then

OstBegin = Sheet.Cells(k; 6)

Else

Do While Sheet.Cells(k; 1) <> Empty

If Sheet.Cells(k; 2) <> CliNum Then Exit Do

If Sheet.Cells(k; 1) = CurDate Then

OstBegin = Sheet.Cells(k; 3)

RowNum = k

Exit Do

End If

k = k + 1

Loop

End If

DoFlag = False

End If

k = k + 1

Loop

If RowNum = 0 Then RowNum = k

k = RowNum

sum = 0

i = 2

While Sheet1.Cells(i; 1) <> Empty

If Sheet1.Cells(i; 1) = CurDate And Sheet1.Cells(i; 2) = CliNum Then

If Sheet1.Cells(i; 4) <> Empty Then

sum = sum - _

Sheet1.Cells(i; 4) * Sheet1.Cells(i; 6) * 10000 - _

Format(Sheet1.Cells(i; 4) * Sheet1.Cells(i; 6) * 100 * ComBirga +

0,0001; "0,00")

Else

If Sheet1.Cells(i; 5) = 100 Then ComBirga = 0

sum = sum + _

Sheet1.Cells(i; 5) * Sheet1.Cells(i; 6) * 10000 - _

Format(Sheet1.Cells(i; 5) * Sheet1.Cells(i; 6) * 100 * ComBirga +

0,0001; "0,00")

End If

End If

i = i + 1

Wend

Sheet.Cells(k; 3) = OstBegin

Sheet.Cells(k; 6) = OstBegin + sum + Sheet.Cells(k; 4)

Sheet.Cells(k; 1) = CurDate

Sheet.Cells(k; 2) = CliNum

End Sub

Sub Ok()

Button = True

End Sub

Sub Cancel()

Button = False

End Sub

Sub ПросмотрОтчетов()

Просмотр = True

End Sub

Sub Останов()

ExitVar = True

End Sub

Sub EndOf()

Dim i As Long

i = 2

While Cells(i; 1) <> Empty

i = i + 1

Wend

Cells(i; 1).Select

End Sub

Function DialogPrint(Str As String; Count As Integer)

With DialogSheets("ДиалогПечать")

AgainView:

Просмотр = False

ExitVar = False

Button = False

.Show

If Просмотр Then

Worksheets(Str).PrintPreview

GoTo AgainView

End If

If ExitVar Then

DialogPrint = True

Else

DialogPrint = False

End If

If Button Then ActiveWindow.SelectedSheets.PrintOut copies:=Count

End With

End Function

Function min(a; b)

If Abs(a) > Abs(b) Then

min = Abs(b)

Else

min = Abs(a)

End If

End Function

Приложение № 1.3. Журнал оборотов.

[pic]

Приложение № 1.4. Журнал лицевого учета.

[pic]

Приложение № 1.5. Мемориальный ордер.

[pic]

Приложение № 1.6. Отчет инвестору о совершенных сделках.

[pic]

Приложение № 1.7. Структура пртфеля в разрезе по бумагам.

[pic]

Приложение № 1.8. Структура портфеля обобщенная.

[pic]

Приложение № 1.9. Биржевая информация.

[pic]

Приложение № 1.10. Еженедельный отчет в депозитарий.

[pic]

Приложение № 1.11. Ежемесячный отчет в депозитарий.

[pic]

Приложение № 2. Программа анализа эффективности вложений в РКО.

Приложение 2.1. Текст программы.

Option Explicit

Option Base 1

'*************************** Сортировка *************************

' Процедура сортировки страницы

' Параметры:

' Sheet - лист

' RangeSort - первая ячейка для сортировки

' StrKey1 - сортировка сначала производится по этому столбцу

' StrKey2 - а затем по этому

' StrKey3 - и по этому в последнюю очередь

' OrderType1 - Направление сортировки по столбцу StrKey1

' OrderType2 - Направление сортировки по столбцу StrKey2

' OrderType3 - Направление сортировки по столбцу StrKey3

' Пример использования :

' Call Сортировка(Worksheets("Биржа"); "A2"; "A2"; "B2"; "C2";

xlAscending; xlDescending; xlAscending)

'*****************************************************************

Sub Сортировка(Sheet As Object; RangeSort As String; StrKey1 As

String; _

StrKey2 As String; StrKey3 As String; TypeOrder1 As Integer;

TypeOrder2 As Integer; TypeOrder3 As Integer)

Sheet.Range(RangeSort).Sort Key1:=Sheet.Range(StrKey1);

Order1:=TypeOrder1; Key2:= _

Sheet.Range(StrKey2); Order2:=TypeOrder2;

Key3:=Sheet.Range(StrKey3); Order3:= _

TypeOrder3; Header:=xlGuess; OrderCustom:=1; MatchCase:=False

_

; Orientation:=xlTopToBottom

End Sub

'******************************* Поиск ***************************

' Функция поиска значения в определенном столбце с определенной

позиции вперед/назад

' Параметры:

' Sheet - лист

' Column - колонка для поиска

' Row - начальная строка поиска

' Text - искомое значение

' Direction - направление поиска:

' 1 - вперед

' -1 - назад

' Пример использования :

' MsgBox Поиск(Worksheets("Биржа"); 4; 8; 5; -1)

'*******************************************************************

Function Поиск(Sheet As Object; Column As Integer; Row As Integer;

Text; Direction As Integer)

Dim i As Integer

Dim Compare; Compare1

If Direction <> 1 And Direction <> -1 Then

MsgBox "Неверно задано направление поиска"

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) = 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 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 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()

Страницы: 1, 2, 3, 4, 5, 6, 7, 8