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

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

Range(Cells(1; BumNum + 2); Cells(100; 30)).Delete shift:=xlToLeft

Range("a2") = "на " + CStr(CurDate)

Range(Cells(n + 2; 1); Cells(n + 3; BumNum + 1)).BorderAround
Weight:=xlMedium

Cells(n + 2; 1) = "Количество перечисленных облигаций на счета
""Депо"""

Cells(n + 3; 1) = "без совершения сделок купли-продажи"

Cells(n + 2; 1).Font.Bold = True

Cells(n + 3; 1).Font.Bold = True

Cells(n + 5; 1).Font.Size = 12

Cells(n + 5; 1) = "Ответственное лицо Дилера " + _

"
_________________________ "

Cells(n + 3; BumNum + 1) = 0

Cells(n + 3; BumNum + 1).Font.Bold = True

If DialogPrint("ОтчетНедельный"; 2) Then Exit Sub

End Sub

'-------------------------------- Печать Отчеты Месячные -----------

Sub PrintOtchMonth()

Dim DateBegin; DateEnd; DateMas() As Date

Dim i; k; m; NumberClients; kk As Long

Dim Sign; BumNum; Row; Col; Num; sum As Integer

Dim DateFlag; Flag; CliInput(); BumInput() As Boolean

Dim Bum(ConstMaxBum) As Long

Dim mas() As Integer

Dim Sheet As Object

Dim Str As String

With DialogSheets("ДиалогМесОтчет")

.EditBoxes(1).InputType = xlDate

.EditBoxes(2).InputType = xlDate

.Show

If Not Button Then Exit Sub

If IsDate(.EditBoxes(1).Text) = False Or _

IsDate(.EditBoxes(2).Text) = False Then

MsgBox "Неверно введены даты"

Exit Sub

End If

DateBegin = CDate(.EditBoxes(1).Text)

DateEnd = CDate(.EditBoxes(2).Text)

If DateBegin >= DateEnd Then

MsgBox "Даты не пересекаются"

Exit Sub

End If

End With

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

BumNum = 0

While Sheet.Cells(i; 1) Empty

If (Sheet.Cells(i; 2) < DateBegin And Sheet.Cells(i; 3) > DateBegin)
Or _

(Sheet.Cells(i; 2) < DateEnd And Sheet.Cells(i; 3) > DateEnd) Or
_

(Sheet.Cells(i; 2) > DateBegin And Sheet.Cells(i; 3) < DateEnd)
Then

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

BumNum = BumNum + 1

End If i = i + 1

Wend

Set Sheet = Worksheets("Клиенты") i = 2 k = 0

While Sheet.Cells(i; 1) Empty

If Sheet.Cells(i; 2) > k And Sheet.Cells(i; 2) FilialConst Then k = Sheet.Cells(i; 2)

End If i = i + 1

Wend

NumberClients = k - DilerConst

DateFlag = True

ReDim mas(NumberClients; BumNum * 7)

ReDim DateMas(NumberClients; BumNum)

ReDim CliInput(NumberClients)

ReDim BumInput(BumNum) i = 2

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

While Cells(i; 1) Empty

If Cells(i; 2) DilerConst And Cells(i; 2) FilialConst Then

If Cells(i; 1) < DateBegin 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

Sign = 1

If IsEmpty(Cells(i; 4)) Then Sign = -1 mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 1) = _ mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 1) + Sign * Cells(i;
6)

End If

If Cells(i; 1) >= DateBegin And DateFlag Then

For k = 1 To NumberClients

For m = 1 To BumNum mas(k; (m - 1) * 7 + 2) = mas(k; (m - 1) * 7 + 1)

Next m

Next k

DateFlag = False

End If

If Cells(i; 1) >= DateBegin And Cells(i; 1) 0 Or _ mas(i; (k - 1) * 7 + 2) > 0 Or _ mas(i; (k - 1) * 7 + 3) > 0 Or _ mas(i; (k - 1) * 7 + 4) > 0 Or _ mas(i; (k - 1) * 7 + 5) > 0 Or _ mas(i; (k - 1) * 7 + 6) > 0 Or _ mas(i; (k - 1) * 7 + 7) > 0 Then CliInput(i) = True

Next k

Next i

For k = 1 To BumNum

BumInput(k) = False

For i = 1 To NumberClients

If mas(i; (k - 1) * 7 + 1) > 0 Or _ mas(i; (k - 1) * 7 + 2) > 0 Or _ mas(i; (k - 1) * 7 + 3) > 0 Or _ mas(i; (k - 1) * 7 + 4) > 0 Or _ mas(i; (k - 1) * 7 + 5) > 0 Or _ mas(i; (k - 1) * 7 + 6) > 0 Or _ mas(i; (k - 1) * 7 + 7) > 0 Then BumInput(k) = True

Next i

Next k

Worksheets("ОтчетМесячный").Select

Range(Cells(7; 1); Cells(800; 22)).Delete shift:=xlToLeft

Row = 4

Col = 2

Cells(2; 1) = "за период от " + CStr(DateBegin) + " до " +
CStr(DateEnd) kk = 0

Flag = False

For k = 1 To BumNum

If BumInput(k) Then

Cells(Row; Col) = Bum(k)

Num = 0

For i = 1 To NumberClients

If CliInput(i) Then

If Col = 2 Then

Str = Format(i; "0000000000")

Str = Right(Str; 5)

Cells(Row + Num + 3; Col - 1).NumberFormat = "@"

Cells(Row + Num + 3; Col - 1).Font.Bold = True

Cells(Row + Num + 3; Col - 1).HorizontalAlignment = xlCenter

Cells(Row + Num + 3; Col - 1).Font.Italic = False

Cells(Row + Num + 3; Col - 1).Interior.ColorIndex = 2

Cells(Row + Num + 3; Col - 1) = Str

End If

Cells(Row + Num + 3; Col) = mas(i; (k - 1) * 7 + 1)

Cells(Row + Num + 3; Col + 1) = mas(i; (k - 1) * 7 + 2)

Cells(Row + Num + 3; Col + 2) = mas(i; (k - 1) * 7 + 3)

Cells(Row + Num + 3; Col + 3) = mas(i; (k - 1) * 7 + 4)

Cells(Row + Num + 3; Col + 4) = mas(i; (k - 1) * 7 + 5)

Cells(Row + Num + 3; Col + 5) = mas(i; (k - 1) * 7 + 6)

Cells(Row + Num + 3; Col + 6) = mas(i; (k - 1) * 7 + 7)

Num = Num + 1

End If

Next i

Col = Col + 7 kk = kk + 1

Flag = True

End If

If ((kk > 0) And (kk Mod 3 = 0) And Flag) Or k = BumNum Then

Flag = False

For i = 2 To 22 sum = 0

For m = 1 To NumberClients sum = sum + Cells(m + 6; i)

Next m

Cells(Num + 7; i) = sum

Cells(Num + 7; i).Font.Bold = True

Cells(Num + 7; i).Interior.ColorIndex = 15

Next i

Cells(Num + 7; 1) = "Итого"

Cells(Num + 7; 1).Font.Bold = True

Cells(Num + 7; 1).HorizontalAlignment = xlCenter

Cells(Num + 7; 1).Interior.ColorIndex = 15

Range(Cells(7; 1); Cells(Num + 7; 22)).Borders(xlLeft).Weight = xlThin

Range(Cells(7; 1); Cells(Num + 7; 22)).Borders(xlRight).Weight = xlThin

Range(Cells(7; 1); Cells(Num + 7; 22)).Borders(xlTop).Weight = xlThin

Range(Cells(7; 1); Cells(Num + 7; 22)).Borders(xlBottom).Weight = xlThin

Range(Cells(7; 1); Cells(Num + 7; 22)).BorderAround
Weight:=xlMedium

Range(Cells(7; 9); Cells(Num + 7; 15)).BorderAround
Weight:=xlMedium

Cells(Num + 10; 10) = "Ответственное лицо
Дилера______________________________"

If DialogPrint("ОтчетМесячный"; 2) Then Exit Sub

Row = 4

Col = 2

Cells(Row; Col) = " "

Cells(Row; Col + 7) = " "

Cells(Row; Col + 14) = " "

Range(Cells(7; 1); Cells(800; 22)).Delete shift:=xlToLeft

End If

Next k

Worksheets("СписокКлиентов").Select

Num = 5

Range(Cells(Num; 1); Cells(100; 3)).Delete shift:=xlToLeft

For i = 1 To NumberClients

If CliInput(i) Then k = 2

While Sheet.Cells(k; 2) DilerConst + i k = k + 1

Wend

Cells(Num; 1) = Sheet.Cells(k; 1)

Cells(Num; 2) = Sheet.Cells(k; 2)

Cells(Num; 3) = Sheet.Cells(k; 3)

Cells(Num; 1).HorizontalAlignment = xlLeft

Cells(Num; 2).HorizontalAlignment = xlCenter

Cells(Num; 3).HorizontalAlignment = xlCenter

Cells(Num; 3).WrapText = True

Num = Num + 1

End If

Next i

Cells(2; 1) = "за период от " + CStr(DateBegin) + " до " +
CStr(DateEnd)

Range(Cells(5; 1); Cells(Num - 1; 3)).Borders(xlLeft).Weight = xlThin

Range(Cells(5; 1); Cells(Num - 1; 3)).Borders(xlRight).Weight = xlThin

Range(Cells(5; 1); Cells(Num - 1; 3)).Borders(xlTop).Weight = xlThin

Range(Cells(5; 1); Cells(Num - 1; 3)).Borders(xlBottom).Weight = xlThin

Range(Cells(5; 1); Cells(Num - 1; 3)).BorderAround Weight:=xlMedium

Range(Cells(5; 2); Cells(Num - 1; 2)).BorderAround Weight:=xlMedium

Cells(Num + 2; 2) = "Ответственное лицо
Дилера______________________________"

With DialogSheets("ДиалогПечать")

AgainMonthOtch1:

Просмотр = False

ExitVar = False

Button = False

.Show

If Просмотр Then

Worksheets("СписокКлиентов").PrintPreview

GoTo AgainMonthOtch1

End If

If ExitVar Then Exit Sub

If Button Then ActiveWindow.SelectedSheets.PrintOut copies:=2

End With

End Sub

'-------------------------------- Перечисление/списание биржа ------

Sub GotoBirga()

Dim Sheet As Object

Dim OstIn; OstOut; OstBegin; CliNum As Double

Dim RowNum; k As Long

Dim DoFlag As Boolean

Set Sheet = Worksheets("ОстаткиБиржа")

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

Key2:=Sheet.Range("A2");
Order2:=xlDescending; _

Header:=xlYes; OrderCustom:=1; _

MatchCase:=False; Orientation:=xlTopToBottom

Sheet.Select

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

While Worksheets("Клиенты").Cells(k; 1) Empty k = k + 1

Wend

With DialogSheets("ДиалогБиржа")

.DropDowns.ListFillRange = "Клиенты!$B$2:$B$" + CStr(k - 1)

.EditBoxes(1).InputType = xlNumber

.EditBoxes(2).InputType = xlNumber

.Show

If Button = False Then

MsgBox "Данные не занесены"

Exit Sub

End If

CliNum = .DropDowns(1).List(.DropDowns(1).ListIndex)

If .EditBoxes(1).Text = "" Then

OstIn = 0

Else

OstIn = .EditBoxes(1).Text

End If

If .EditBoxes(2).Text = "" Then

OstOut = 0

Else

OstOut = .EditBoxes(2).Text

End If

OstBegin = 0 k = 2

DoFlag = True

Do While Cells(k; 1) Empty

If Cells(k; 2) = CliNum And DoFlag Then

If Cells(k; 1) < CurDate Then

OstBegin = Cells(k; 6)

Else

MsgBox "Невозможен ввод информации"

Exit Sub

End If

DoFlag = False

End If k = k + 1

Loop

Cells(k; 1) = CurDate

Cells(k; 2) = CliNum

Cells(k; 3) = OstBegin

Cells(k; 4) = OstIn

Cells(k; 5) = OstOut

Cells(k; 6) = OstBegin + OstIn - OstOut

End With

End Sub

'-------------------------------- Просмотр остатков 812 ------------

Sub PrintOst()

Dim Sheet; Sheet1 As Object

Dim i; k; CliNum As Long

Dim Ost As Double

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

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

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

Call EditOstBirga(Worksheets("Сделки").Cells(i; 2))

End If i = i + 1

Wend

Set Sheet = Worksheets("Остатки812")

Set Sheet1 = Worksheets("ОстаткиБиржа")

Sheets("Клиенты").Select i = 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

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

Key2:=Sheet1.Range("A2");
Order2:=xlDescending; _

Header:=xlYes; OrderCustom:=1; _

MatchCase:=False; Orientation:=xlTopToBottom

While Cells(i; 2) Empty

CliNum = Cells(i; 2) k = 2

Do

If Sheet.Cells(k; 1) = Empty Then

Ost = 0

Exit Do

End If

If Sheet.Cells(k; 2) = CliNum Then

Ost = Sheet.Cells(k; 8)

Exit Do

End If k = k + 1

Loop

Cells(i; 4) = Ost k = 2

Do

If Sheet1.Cells(k; 1) = Empty Then

Ost = 0

Exit Do

End If

If Sheet1.Cells(k; 2) = CliNum Then

Ost = Sheet1.Cells(k; 6)

Exit Do

End If k = k + 1

Loop

Cells(i; 5) = Ost i = i + 1

Wend

End Sub

'-------------------------------- Печать портфель ------------------

Sub PrintPortfel()

Dim Sheet As Object

Dim i; k; BumNum; m As Long

Dim Bum(ConstMaxBum); DatePog(ConstMaxBum) As Long

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

Dim Price(); BumPrice(); DohPog(); DohPriobr() As Double

Dim DateMas() As Date

Dim Flag; BumIndex() As Boolean

Dim SumPog1(); SumPog2(); SumPriobr1(); SumPriobr2() As Double

Dim SumPog11; SumPriobr11; SumPog22; SumPriobr22 As Double

Dim BumVol() As Integer

Dim AllVol As Long

Dim PortfelCost; PortfelBalance As Double

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

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)

DatePog(BumNum + 1) = Sheet.Cells(i; 3)

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 DohPog(BumNum; MaxCount)

ReDim DohPriobr(BumNum; MaxCount)

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

ReDim BumIndex(BumNum); BumPrice(BumNum)

ReDim SumPog1(BumNum); SumPog2(BumNum); SumPriobr1(BumNum);
SumPriobr2(BumNum)

ReDim BumVol(BumNum)

For i = 1 To BumNum dates(i) = 1

Next i

i = 2

While Cells(i; 1) Empty

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 Cells(i; 1) 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

i = 2

While Cells(i; 1) 0 Then

BumPrice(k) = Sheet.Cells(i; 6)

Else

BumPrice(k) = 0

End If

End If

Next k

End If i = i + 1

Wend

If Flag Then

MsgBox "Биржевой информации нет. Портфель сформировать невозможно."

Exit Sub

End If

Worksheets("Портфель1").Select

Cells(4; 3) = CurDate

Range("A7:H200").Delete shift:=xlToLeft m = 7

PortfelCost = 0

PortfelBalance = 0

For k = 1 To BumNum

If Volume(k; BeginIndex(k)) > 0 Then

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

If Volume(k; i) > 0 Then

Cells(m; 1) = Bum(k)

Cells(m; 1).NumberFormat = "0"

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

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

Cells(m; 3) = Price(k; i)

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

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

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

DohPog(k; i) = (100 / Price(k; i) - 1) * 36500 / (DatePog(k) -
DateMas(k; i))

Cells(m; 5) = DohPog(k; i)

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

Cells(m; 8).NumberFormat = "0"

Dim tmp As Long tmp = CurDate - DateMas(k; i)

Cells(m; 8) = tmp

PortfelBalance = PortfelBalance + Price(k; i) * Volume(k; i)

If BumPrice(k) > 0 Then

PortfelCost = PortfelCost + BumPrice(k) * Volume(k; i)

Else

PortfelCost = PortfelCost + Price(k; i) * Volume(k; i)

End If

If BumPrice(k) > 0 Then

Cells(m; 6) = BumPrice(k)

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

If CurDate DateMas(k; i) Then

DohPriobr(k; i) = (BumPrice(k) / Price(k; i) - 1) * 36500 /
(CurDate - DateMas(k; i))

Cells(m; 7) = DohPriobr(k; i)

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

End If

End If m = m + 1

End If

Next i

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

End If

Next k

Range(Cells(7; 1); Cells(m - 1; 8)).Borders(xlLeft).Weight = xlThin

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

Range(Cells(7; 1); Cells(m - 1; 8)).Borders(xlTop).Weight = xlThin

Range(Cells(7; 1); Cells(m - 1; 8)).Borders(xlBottom).Weight = xlThin

Range(Cells(7; 1); Cells(m - 1; 8)).BorderAround Weight:=xlMedium

If DialogPrint("Портфель1"; 1) Then Exit Sub

Worksheets("Портфель2").Select

Cells(4; 3) = CurDate

SumPog11 = 0

SumPog22 = 0

SumPriobr11 = 0

SumPriobr22 = 0

AllVol = 0 m = 7

Range("A7:H200").Delete shift:=xlToLeft

For k = 1 To BumNum

If Volume(k; BeginIndex(k)) > 0 Then

SumPog1(k) = 0

SumPog2(k) = 0

SumPriobr1(k) = 0

SumPriobr2(k) = 0

BumVol(k) = 0

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

If Volume(k; i) > 0 Then

SumPog1(k) = SumPog1(k) + DohPog(k; i) * Volume(k; i) *
(DatePog(k) - DateMas(k; i))

SumPog2(k) = SumPog2(k) + Volume(k; i) * (DatePog(k) - DateMas(k; i))

If CurDate DateMas(k; i) Then

SumPriobr1(k) = SumPriobr1(k) + DohPriobr(k; i) * Volume(k; i) *
(CurDate - DateMas(k; i))

SumPriobr2(k) = SumPriobr2(k) + Volume(k; i) * (CurDate -
DateMas(k; i))

End If

SumPog11 = SumPog11 + SumPog1(k)

SumPog22 = SumPog22 + SumPog2(k)

SumPriobr11 = SumPriobr11 + SumPriobr1(k)

SumPriobr22 = SumPriobr22 + SumPriobr2(k)

BumVol(k) = BumVol(k) + Volume(k; i)

AllVol = AllVol + Volume(k; i)

End If

Next i

Cells(m; 1) = Bum(k)

Cells(m; 1).NumberFormat = "0"

Cells(m; 2) = BumVol(k)

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

Cells(m; 3) = SumPog1(k) / SumPog2(k)

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

If SumPriobr2(k) > 0 And SumPriobr1(k) > 0 Then

Cells(m; 4) = SumPriobr1(k) / SumPriobr2(k)

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

End If m = m + 1

End If

Next k

Cells(m; 1) = "Итого"

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

Cells(m; 1).HorizontalAlignment = xlCenter

Cells(m; 2) = AllVol

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

Cells(m; 3) = SumPog11 / SumPog22

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

Cells(m; 4) = SumPriobr11 / SumPriobr22

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

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

Range(Cells(7; 1); Cells(m; 4)).Borders(xlLeft).Weight = xlThin

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

Range(Cells(7; 1); Cells(m; 4)).Borders(xlTop).Weight = xlThin

Range(Cells(7; 1); Cells(m; 4)).Borders(xlBottom).Weight = xlThin

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

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

Cells(m + 1; 1) = "Стоимость портфеля по балансу"

Cells(m + 2; 1) = "Текущая стоимость потфеля"

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

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

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

Cells(m + 1; 4) = PortfelBalance * 10

Cells(m + 1; 4).NumberFormat = "### ### ###,00"

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

Cells(m + 2; 4) = PortfelCost * 10

Cells(m + 2; 4).NumberFormat = "### ### ###,00"

Cells(m + 2; 4).Font.Bold = True

If DialogPrint("Портфель2"; 1) Then Exit Sub

End Sub

'-------------------------------- Печать Журнала лицевого учета -------
--

Sub PrintMagazine()

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