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

Dim i; k; BumNum; m; m1; j As Long

Dim Bum(ConstMaxBum) As Long

Dim Volume(); BiginIndex(); dates(); V(); Vol As Integer

Dim sum; Price() As Double

Dim DateMas() As Date

Dim Flag; BumIndex() As Boolean

Dim ComBirga; ComMas(); MagMas(); Mag(4) As Double

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

Flag = True

Do While Worksheets("Сделки").Cells(i; 1) Empty

If Worksheets("Сделки").Cells(i; 1) = CurDate And _

Worksheets("Сделки").Cells(i; 2) = DilerConst Then

Flag = False

Exit Do

End If i = i + 1

Loop

If Flag Then

MsgBox "Сделок в текущий день не было"

Exit Sub

End If

Set Sheet = Worksheets("Бумаги") i = 2

BumNum = 0

While Sheet.Cells(i; 1) Empty

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

Bum(BumNum + 1) = Sheet.Cells(i; 1)

BumNum = BumNum + 1

End If i = i + 1

Wend

Worksheets("Сделки").Select

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

Key2:=Range("D2"); Order2:=xlAscending; _

Header:=xlYes; OrderCustom:=1; _

MatchCase:=False; Orientation:=xlTopToBottom

ReDim Volume(BumNum; MaxCount)

ReDim Price(BumNum; MaxCount)

ReDim DateMas(BumNum; MaxCount)

ReDim dates(BumNum); V(BumNum); BeginIndex(BumNum)

ReDim BumIndex(BumNum); ComMas(BumNum)

ReDim MagMas(BumNum; 4)

For i = 1 To BumNum

ComMas(i) = 0 dates(i) = 1

Next i i = 2

While Cells(i; 1) Empty And CurDate > Cells(i; 1)

If Cells(i; 2) = DilerConst And Cells(i; 7) "списание" _

And Cells(i; 7) "зачисление" Then

Flag = True

For k = 1 To BumNum ' поиск номера бумаги

If Cells(i; 3) = Bum(k) Then

Flag = False

Exit For

End If

Next k

If Flag Then GoTo cont

If Not IsEmpty(Cells(i; 4)) Then

Volume(k; dates(k)) = Cells(i; 6)

Price(k; dates(k)) = Cells(i; 4)

DateMas(k; dates(k)) = Cells(i; 1) dates(k) = dates(k) + 1

V(k) = V(k) + Cells(i; 6)

Else

V(k) = V(k) - Cells(i; 6)

End If

End If cont: i = i + 1

Wend

For k = 1 To BumNum

For i = dates(k) To 1 Step -1

If V(k) > Volume(k; i) Then

V(k) = V(k) - Volume(k; i)

Else

Volume(k; i) = V(k)

BeginIndex(k) = i

Exit For

End If

Next i

Next k

For k = 1 To BumNum

BumIndex(k) = False

If V(k) > 0 Then BumIndex(k) = True

Next k

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

While Cells(i; 1) Empty

If (Cells(i; 1) = CurDate And Cells(i; 2) = DilerConst) _

And (Cells(i; 7) "зачисление" And Cells(i; 7) "списание")
Then

For k = 1 To BumNum

If Cells(i; 3) = Bum(k) Then

BumIndex(k) = True

If Not IsEmpty(Cells(i; 4)) Then

ComMas(k) = ComMas(k) + Format(Cells(i; 4) * Cells(i; 6) *
ComBirga * 0,1 + 0,0001; "0,00")

Else

If Cells(i; 5) 100 Then

ComMas(k) = ComMas(k) + Format(Cells(i; 5) * Cells(i; 6) *
ComBirga * 0,1 + 0,0001; "0,00")

End If

End If

End If

Next k

End If i = i + 1

Wend

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

Worksheets("Журнал лицевого учета").Select

Cells(5; 1) = CurDate

Cells(49; 2) = ComBirga

Покупка = False

Продажа = False

Vol = 0 sum = 0

For k = 1 To BumNum

If BumIndex(k) Then m = 7

Range("A7:C43").ClearContents

Range("E7:G43").ClearContents

Vol = 0 sum = 0

For i = BeginIndex(k) To dates(k)

If Volume(k; i) > 0 Then

Cells(m; 1) = DateMas(k; i)

Cells(m; 2) = Volume(k; i)

Cells(m; 3) = Format(Price(k; i); "0,00")

Vol = Vol + Volume(k; i) sum = sum + Format(Price(k; i); "0,00") * Volume(k; i) * 10 m = m + 1

End If

Next i

Cells(6; 2) = Vol

Cells(6; 4) = sum

Cells(49; 3) = ComMas(k)

Cells(5; 3) = CStr(Bum(k)) + "MFTS" i = 2 m1 = 7 j = BeginIndex(k)

While Sheet.Cells(i; 1) Empty

If Sheet.Cells(i; 1) = CurDate And Sheet.Cells(i; 3) = Bum(k) And
_

Sheet.Cells(i; 7) "зачисление" And Sheet.Cells(i; 7)
"списание" And _

Sheet.Cells(i; 2) = DilerConst Then

If Not IsEmpty(Sheet.Cells(i; 4)) Then

Покупка = True

Cells(m; 1) = Sheet.Cells(i; 1)

Cells(m; 2) = Sheet.Cells(i; 6)

Cells(m; 3) = Sheet.Cells(i; 4)

Volume(k; dates(k)) = Sheet.Cells(i; 6)

Price(k; dates(k)) = Sheet.Cells(i; 4)

DateMas(k; dates(k)) = Sheet.Cells(i; 4) dates(k) = dates(k) + 1 m = m + 1

Else

Продажа = True

Vol = Sheet.Cells(i; 6)

If Vol < Volume(k; j) Then

Cells(m1; 5) = Vol

Cells(m1; 6) = Format(Price(k; j); "0,00")

Cells(m1; 7) = Sheet.Cells(i; 5)

Volume(k; j) = Volume(k; j) - Sheet.Cells(i; 6) m1 = m1 + 1

Else

If Volume(k; j) = 0 Then j = j + 1

While Vol > Volume(k; j) And Volume(k; j) Empty

Cells(m1; 5) = Volume(k; j)

Cells(m1; 6) = Format(Price(k; j); "0,00")

Cells(m1; 7) = Sheet.Cells(i; 5)

Vol = Vol - Volume(k; j) j = j + 1 m1 = m1 + 1

Wend

If Volume(k; j) Empty Then

Cells(m1; 5) = Vol

Cells(m1; 6) = Format(Price(k; j); "0,00")

Cells(m1; 7) = Sheet.Cells(i; 5)

Volume(k; j) = Volume(k; j) - Vol m1 = m1 + 1

End If

End If

End If

End If i = i + 1

Wend no_do:

MagMas(k; 1) = Format(Cells(46; 3); "0,00")

MagMas(k; 2) = Format(Cells(47; 3); "0,00")

MagMas(k; 3) = Format(Cells(48; 3); "0,00")

MagMas(k; 4) = Format(Cells(45; 4); "0,00")

If DialogPrint("Журнал лицевого учета"; 1) Then Exit Sub

End If

Next k

' Формирование журнала оборотов

Worksheets("ЖурналОборотов").Select

Cells(6; 1) = CurDate

Range(Cells(7; 1); Cells(100; 6)).Delete shift:=xlToLeft m = 7

For k = 1 To BumNum

If BumIndex(k) Then

Cells(m; 1) = CStr(Bum(k)) + "MFTS"

Cells(m; 2) = MagMas(k; 1)

Cells(m; 3) = MagMas(k; 2)

Cells(m; 4) = MagMas(k; 3)

Cells(m; 5) = MagMas(k; 4)

Cells(m; 6) = ComMas(k)

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

Cells(m; 2).NumberFormat = "0,00"

Cells(m; 3).NumberFormat = "0,00"

Cells(m; 4).NumberFormat = "0,00"

Cells(m; 5).NumberFormat = "0,00"

Cells(m; 6).NumberFormat = "0,00" m = m + 1

End If

Next k

For i = 2 To 6 sum = 0

For m1 = 7 To m - 1 sum = sum + Cells(m1; i)

Next m1

Cells(m; i) = sum

Cells(m; i).NumberFormat = "0,00"

Next i

Mag(1) = Cells(m; 2)

Mag(2) = Cells(m; 3)

Mag(3) = Cells(m; 4)

Mag(4) = Cells(m; 6)

If Cells(m; 2) > 0 Then Cells(m + 1; 2) = "Дт" + S192

If Cells(m; 2) < 0 Then Cells(m + 1; 2) = "Кт" + S192

If Cells(m; 3) > 0 Then Cells(m + 1; 3) = "Дт" + S904

If Cells(m; 3) < 0 Then Cells(m + 1; 3) = "Кт" + S904

If Cells(m; 4) > 0 Then Cells(m + 1; 4) = "Кт" + S960

If Cells(m; 4) < 0 Then Cells(m + 1; 4) = "Дт" + S970

Cells(m + 1; 6) = "Дт" + S970

Range(Cells(m + 1; 2); Cells(m + 2; 6)).HorizontalAlignment = xlCenter

Range(Cells(m + 1; 1); Cells(m + 1; 6)).Interior.ColorIndex = 15

Cells(m + 2; 6) = "Кт" + S904

Cells(m + 2; 6).Interior.ColorIndex = 15

Range(Cells(7; 1); Cells(m - 1; 6)).Borders(xlRight).Weight = xlThin

Range(Cells(m; 1); Cells(m; 6)).Borders(xlRight).LineStyle = xlDouble

Range(Cells(m; 1); Cells(m; 6)).Borders(xlLeft).LineStyle = xlDouble

Range(Cells(m; 1); Cells(m; 6)).Borders(xlTop).LineStyle = xlDouble

Range(Cells(m; 1); Cells(m; 6)).Borders(xlBottom).LineStyle = xlDouble

Cells(m + 2; 4) = "Подпись ответственного"

Cells(m + 3; 4) = "сотрудника"

Range(Cells(m + 2; 4); Cells(m + 3; 4)).Font.Size = 8

Range(Cells(m + 2; 4); Cells(m + 3; 4)).HorizontalAlignment = xlLeft

Range(Cells(7; 1); Cells(m + 4; 6)).BorderAround Weight:=xlMedium

Range(Cells(m + 2; 3); Cells(m + 4; 3)).Borders(xlRight).Weight = xlThin

Range(Cells(m + 1; 1); Cells(m + 1; 5)).Borders(xlBottom).Weight = xlThin

Cells(m + 2; 6).Borders(xlLeft).Weight = xlThin

Cells(m + 2; 6).Borders(xlBottom).Weight = xlThin

If DialogPrint("ЖурналОборотов"; 1) Then Exit Sub

' печать мемориального ордера

Dim StrS As String

With DialogSheets("ДиалогОперация")

.Show

If .OptionButtons(1).Value = xlOn Then StrS = "Покупка"

If .OptionButtons(2).Value = xlOn Then StrS = "Продажа"

If .OptionButtons(3).Value = xlOn Then StrS = "Погашение"

If .OptionButtons(4).Value = xlOn Then StrS = "Покупка / Продажа"

If .OptionButtons(5).Value = xlOn Then StrS = "Покупка / Погашение"

End With

Worksheets("Ордер").Select i = CInt(InputBox("Введите номер 1-го ордера"))

If Mag(1) > 0 Then

If Mag(2) < 0 Then

If MemoOrder(i; min(Mag(1); Mag(2)); S192; S904; 0; _

StrS + " РКО за " + CStr(CurDate)) Then Exit Sub i = i + 1

End If

If Mag(3) > 0 Then

If MemoOrder(i; min(Mag(1); Mag(3)); S192; S960; 0; _

"Доход от продажи РКО за " + CStr(CurDate)) Then Exit Sub i = i + 1

End If

End If

If Mag(2) > 0 Then

If Mag(1) < 0 Then

If MemoOrder(i; min(Mag(2); Mag(1)); S904; S192; 0; _

StrS + " РКО за " + CStr(CurDate)) Then Exit Sub i = i + 1

End If

If Mag(3) > 0 Then

If MemoOrder(i; min(Mag(2); Mag(3)); S904; S960; 0; _

"Доход от продажи РКО за " + CStr(CurDate)) Then Exit Sub i = i + 1

End If

End If

If Mag(3) < 0 Then

If Mag(1) < 0 Then

If MemoOrder(i; min(Mag(3); Mag(1)); SR970; S192; 0; _

"Отрицательная разница от продажи РКО за " + CStr(CurDate))
Then Exit Sub i = i + 1

End If

If Mag(2) < 0 Then

If MemoOrder(i; min(Mag(3); Mag(2)); SR970; S904; 0; _

"Отрицательная разница от продажи РКО за " + CStr(CurDate))
Then Exit Sub i = i + 1

End If

End If

If Format(Mag(4)) > 0 Then

If MemoOrder(i; Mag(4); S970; S904; 0; _

"Комиссия ВКБ в т.ч. НДС " + CStr(Format(Mag(4) / 6; "0,00"))) Then
Exit Sub

End If

End Sub

'-------------------------------------------- Memo Order

Function MemoOrder(Num; sum As Double; n1; n2; Pos As Integer; Order
As String)

Dim i As Integer

Dim Flag As Boolean

Dim Str; Str1 As String

Str1 = ""

Str = CStr(sum)

Str = Format(Str; "000000000000,00")

Flag = False

For i = 1 To Len(Str)

If Mid(Str; i; 1) = "," Then

If CInt(Right(Str; 2)) = 0 Then

Str1 = Str1 + "="

Exit For

Else

Str1 = Str1 + "-"

End If

Else

If Mid(Str; i; 1) "0" Then Flag = True

If Mid(Str; i; 1) "0" Or Flag Then Str1 = Str1 + Mid(Str; i; 1)

End If

Next i

Cells(3; 6) = Str1

If Pos > 0 Then

If n1 > 6 Then

Cells(5; 6) = Worksheets("Клиенты").Cells(2; n1)

Else

Cells(5; 6) = Worksheets("Клиенты").Cells(Pos; n1)

End If

If n2 > 6 Then

Cells(10; 6) = Worksheets("Клиенты").Cells(2; n2)

Else

Cells(10; 6) = Worksheets("Клиенты").Cells(Pos; n2)

End If

Else

Cells(5; 6) = n1

Cells(10; 6) = n2

End If

Cells(16; 1) = Order

Cells(1; 6) = Num

Range("A1:H24").Copy

Range("A32").Select

ActiveSheet.Paste

If DialogPrint("Ордер"; 2) Then

MemoOrder = True

Else

MemoOrder = False

End If

End Function

'-------------------------------- Печать биржевой информации -------

Sub PrintBirgaInfo()

Dim Sheet As Object

Dim Flag As Boolean

Dim i; n; k; Num As Long

Dim mas(3) As Double

Set Sheet = Worksheets("Биржа")

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

Sheets("Биржевая Информация").Select

Cells(3; 10) = CurDate

For i = 1 To 3 mas(i) = 0

Next i i = 2 n = 7

Range(Cells(n; 1); Cells(n + 100; 17)).Delete shift:=xlToLeft

Flag = True

Do While Sheet.Cells(i; 1) Empty

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

Flag = False

Cells(n; 1) = Sheet.Cells(i; 2)

Cells(n; 7) = Sheet.Cells(i; 3)

Cells(n; 9) = Sheet.Cells(i; 4)

Cells(n; 10) = Sheet.Cells(i; 5)

Cells(n; 5).Font.Bold = True

Cells(n; 11) = Sheet.Cells(i; 6)

Cells(n; 11).Font.Bold = True

Cells(n; 12) = Sheet.Cells(i; 7)

Cells(n; 13) = Sheet.Cells(i; 8) k = 2

While Worksheets("Бумаги").Cells(k; 1) Empty

If Worksheets("Бумаги").Cells(k; 1) = Cells(n; 1) Then

Cells(n; 2) = Worksheets("Бумаги").Cells(k; 2)

Cells(n; 3) = Worksheets("Бумаги").Cells(k; 3)

Cells(n; 6) = Worksheets("Бумаги").Cells(k; 4)

End If k = k + 1

Wend

Cells(n; 2).NumberFormat = "ДД.ММ.ГГ"

Cells(n; 3).NumberFormat = "ДД.ММ.ГГ"

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

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

Range(Cells(n; 10); Cells(n; 17)).NumberFormat = "0,00"

Cells(n; 4) = Cells(3; 10) - Cells(n; 2)

Cells(n; 5) = Cells(n; 3) - Cells(3; 10)

Cells(n; 8) = Cells(n; 9) / Cells(n; 6) * 100

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

If Cells(n; 7) 0 And Cells(n; 5) 0 Then

Cells(n; 14) = (100 / Cells(n; 10) - 1) * 36500 / Cells(n; 5) *
0,85

Cells(n; 15) = (100 / Cells(n; 10) - 1) * 36500 / Cells(n; 5)

Cells(n; 16) = (100 / Cells(n; 11) - 1) * 36500 / Cells(n; 5) *
0,85

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

Cells(n; 17) = (100 / Cells(n; 11) - 1) * 36500 / Cells(n; 5) mas(1) = mas(1) + Cells(n; 5) * Cells(n; 9) * Cells(n; 14) mas(2) = mas(2) + Cells(n; 5) * Cells(n; 9) * Cells(n; 16) mas(3) = mas(3) + Cells(n; 5) * Cells(n; 9)

End If n = n + 1

End If i = i + 1

Loop

If Flag Then

MsgBox "Биржевой информации нет"

Exit Sub

End If

Num = n

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

Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlRight).Weight = 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

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