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

If DepoArray(i; k) <> 0 Then

Cells(n; k + 1) = DepoArray(i; k)

Else

Cells(n; k + 1) = ""

End If

Cells(n; k + 1).Font.Bold = False

Cells(n; k + 1).Font.Italic = False

Cells(n; k + 1).Interior.ColorIndex = 2

Next

If n = 7 Then

n = n + 2

Else

n = n + 1

End If

End If

Next

For i = 1 To BumNum

Cells(n; i + 1).Interior.ColorIndex = 40

s = 0

For k = 9 To n - 1

s = s + Cells(k; i + 1)

Next

Cells(n; i + 1).Value = s

Next

Cells(n; 1).Interior.ColorIndex = 40

Cells(n; 1) = "Итого по инвесторам"

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

Cells(n; 1).Font.Italic = True

Range("A1:Z200").Borders(xlLeft).LineStyle = xlNone

Range("A1:Z200").Borders(xlRight).LineStyle = xlNone

Range("A1:Z200").Borders(xlTop).LineStyle = xlNone

Range("A1:Z200").Borders(xlBottom).LineStyle = xlNone

Range("A1:Z200").BorderAround LineStyle:=xlNone

Range(Cells(5; 1); Cells(n; BumNum + 1)).Borders(xlLeft).Weight =

xlThin

Range(Cells(5; 1); Cells(n; BumNum + 1)).Borders(xlRight).Weight =

xlThin

Range(Cells(5; 1); Cells(n; BumNum + 1)).Borders(xlTop).Weight =

xlThin

Range(Cells(5; 1); Cells(n; BumNum + 1)).Borders(xlBottom).Weight =

xlThin

Range(Cells(5; 1); Cells(n; BumNum + 1)).BorderAround

Weight:=xlMedium

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) "списание" And Cells(i; 7) <> "зачисление" Then

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

mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 3) = _

mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 3) + Cells(i; 6)

Else

mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 4) = _

mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 4) + Cells(i; 6)

End If

If DateMas(Cells(i; 2) - DilerConst; k) <> Cells(i; 1) Then

DateMas(Cells(i; 2) - DilerConst; k) = Cells(i; 1)

mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 5) = _

mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 5) + 1

End If

End If

If Cells(i; 7) = "списание" Then

mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 6) = _

mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 6) + Cells(i; 6)

End If

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

mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 7) = _

mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 7) + Cells(i; 6)

End If

Sign = 1

If IsEmpty(Cells(i; 4)) Then Sign = -1

mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 2) = _

mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 2) + Sign * Cells(i;

6)

End If

End If

cont:

i = i + 1

Wend

For i = 1 To NumberClients

CliInput(i) = False

For k = 1 To BumNum

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 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) 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

End If

Next k

End If

i = i + 1

Wend

i = 2

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

Flag = True

While Sheet.Cells(i; 1) <> Empty

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

Flag = False

For k = 1 To BumNum

If Sheet.Cells(i; 2) = Bum(k) Then

If Sheet.Cells(i; 6) > 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"

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