Анализ эффективности вложений денежных средств в РКО (стр. 9 из 10)
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. Журнал оборотов.
Приложение № 1.4. Журнал лицевого учета.
Приложение № 1.5. Мемориальный ордер.
Приложение № 1.6. Отчет инвестору о совершенных сделках.
Приложение № 1.7. Структура пртфеля в разрезе по бумагам.
Приложение № 1.8. Структура портфеля обобщенная.
Приложение № 1.9. Биржевая информация.
Приложение № 1.10. Еженедельный отчет в депозитарий.
Приложение № 1.11. Ежемесячный отчет в депозитарий.
Приложение № 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) <= 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