Анализ эффективности вложений денежных средств в РКО
Страница 14
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. Журнал оборотов.
Приложение № 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 ' максимальное количество бумаг в портфеле одной серии