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)
min = Abs(a)
Приложение № 1.3. Журнал оборотов.
[pic]
Приложение № 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
'******************************* Поиск ***************************
' Функция поиска значения в определенном столбце с определенной
позиции вперед/назад
' 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
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)
If IsNumeric(Text) Then
Compare = CDbl(Sheet.Cells(i; Column))
Compare1 = CDbl(Text)
Compare = CStr(Sheet.Cells(i; Column))
Compare1 = CStr(Text)
If Compare = Compare1 Then
Поиск = i
Exit Function
i = i + Direction
Wend
Поиск = 0
ErrorFuncFind:
MsgBox "Несовпадение типов данных в вызове" + Chr(13) + "функции
Поиск и в искомом столбце." _
+ Chr(13) + Chr(13) + "Данные разных типов в столбце базы" +
Chr(13)
' ---------------------------- Общая часть ----------------------------
---------
' внешние параметры
' тип данных для записи информации о бумаге
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 ' количество бумаг данной серии в портфеле
' тип данных для записи информации об индксах портфеля и рынка
Type IndexRecord
Dates As Date
Portfel As Single
Birga As Single
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
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)
With DialogSheets("ДиалогВыбор")
again:
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
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)
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)
Portfel.StartPos(i) = 1
Portfel.EndPos(i) = 0
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
If SumCell < Portfel.Volume(Ind; Portfel.StartPos(Ind)) Then
Portfel.Volume(Ind; Portfel.StartPos(Ind)) = Portfel.Volume(Ind;
Portfel.StartPos(Ind)) - SumCell
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20