| |||||
МЕНЮ
| Анализ эффективности вложений денежных средств в РКО.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() End End Sub Приложение № 2.2. Диаграмма сравнения доходности портфеля и рынка. [pic] Приложение № 2.3. Диаграмма сравнения индекса портфеля и рынка. [pic] Приложение № 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 | Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 |
ИНТЕРЕСНОЕ | |||
|