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

i = 1

While Worksheets("Клиенты").Cells(i + 1; 2) <> _

Worksheets("Сделки").Cells(a; 2)

If Worksheets("Клиенты").Cells(i + 1; 2) = Empty Then

MsgBox "Неверный номер клиента в Окне 'Сделки' строка: " + CStr(a)

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

Cells(a; 2).Select

Exit Sub

End If

i = i + 1

Wend

k = 0

For j = 1 To BumNum

If Worksheets("Врем").Cells(j; 1) = Worksheets("Сделки").Cells(a; 3) Then

k = j

Exit For

End If

Next

If k = 0 Then

a = a + 1

GoTo NNN

End If

If Not IsEmpty(Worksheets("Сделки").Cells(a; 4)) Then

Sign = 1

Else

Sign = -1

End If

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

If Worksheets("Сделки").Cells(a; 2) = FilialConst Then

DepoFil(k) = DepoFil(k) + Sign * Worksheets("Сделки").Cells(a; 6)

Else

DepoArray(i; k) = DepoArray(i; k) + Sign * Worksheets("Сделки").Cells(a; 6)

End If

End If

a = a + 1

NNN:

Wend

n = 7

For i = 1 To CliNum

Flag = False

For k = 1 To BumNum

If DepoArray(i; k) > 0 Then Flag = True

Next

If Flag Then

Str = Format(Worksheets("Клиенты").Cells(i + 1; 2); "0000000000")

Str = Right(Str; 5)

Cells(n; 1).NumberFormat = "@"

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

Cells(n; 1).HorizontalAlignment = xlCenter

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

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

Cells(n; 1) = Str

For k = 1 To BumNum

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 + 4

Else

n = n + 1

End If

End If

Next

'расчет по филиалу

Cells(8; 1) = "Филиал"

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

Cells(8; 1).HorizontalAlignment = xlCenter

Cells(8; 1).Font.Italic = False

Cells(8; 1).Interior.ColorIndex = 2

For k = 1 To BumNum

If DepoFil(k) <> 0 Then

Cells(8; k + 1) = DepoFil(k)

Else

Cells(8; k + 1) = ""

End If

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

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

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

Next

For i = 1 To BumNum

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

s = 0

For k = 11 To n - 1

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

Next

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

Next

For i = 1 To BumNum

Cells(9; i + 1) = Cells(7; i + 1) + Cells(8; i + 1)

Next

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

Cells(n; 1) = "Итого 9998"

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

If DialogPrint("Депо"; 1) Then Exit Sub

Call EditOstBirga(DilerConst)

End Sub

'-------------------------------- Печать Отчеты клиентам -----------

Sub PrintOtchClient()

Dim Sheet; Ost812 As Object

Dim i; j; d; a; Col; m; MM; NN; MMM; k; b; q As Long

Dim FlagBuy; FlagCell; FlagDeal; FlagDepo As Boolean

Dim CliNum As Long

Dim ComStr; StrComS As String

Dim BumNum; z; z1; Index As Integer

Dim s; sum; SumBuy; Ost; SumCom; ComBirga; ComDiler; ComSum As Double

Dim Com As Double

Dim OstIn; OstOut; OstBegin; OstEnd As Double

Dim RowNum As Long

Dim OstInDate; OstOutDate As String

Dim DoFlag As Boolean

Dim Auk As Boolean

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

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

Key2:=Sheet.Range("B2"); Order2:=xlAscending; _

Key3:=Sheet.Range("D2"); Order3:=xlAscending; _

Header:=xlYes; OrderCustom:=1; _

MatchCase:=False; Orientation:=xlTopToBottom

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

Worksheets("ОтчетыИнвесторам").Select

i = 2

FlagDeal = False

FlagBuy = True

FlagCell = True

NN = 29 ' начало

m = NN

Range(Cells(NN - 1; 2); Cells(NN + 200; 6)).Delete shift:=xlToLeft

Rows(CStr(NN - 1) + ":" + CStr(NN - 1)).RowHeight = 28

Rows(CStr(NN - 1) + ":" + CStr(NN - 1)).WrapText = True

Rows(CStr(NN - 1) + ":" + CStr(NN - 1)).HorizontalAlignment = xlCenter

Rows(CStr(NN - 1) + ":" + CStr(NN - 1)).VerticalAlignment = xlBottom

Cells(NN - 1; 2) = "№ выпуска"

Cells(NN - 1; 3) = "Дата погашения"

Cells(NN - 1; 4) = "Цена сделки"

Cells(NN - 1; 5) = "Количество"

Cells(NN - 1; 6) = "Сумма сделки"

Cells(NN - 3; 3) = "Совершенные сделки на рынке РКО"

Cells(NN - 3; 3).Font.Bold = True

sum = 0

SumBuy = 0

SumCom = 0

ComBirga = 0

Call FormBum

BumNum = Worksheets("Врем").Cells(1; 2)

ReDim BumArray(BumNum)

ReDim BumArrayV(BumNum)

Index = CInt(InputBox("Введите номер 1-го ордера"))

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

If Sheet.Cells(i; 1) = CurDate And Sheet.Cells(i; 2) <> DilerConst Then

FlagDeal = True

If FlagBuy And Sheet.Cells(i; 4) <> Empty Then

Покупка = True

CliNum = Sheet.Cells(i; 2)

Cells(m; 2) = "Покупка"

Cells(m; 2).HorizontalAlignment = xlLeft

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

m = m + 1

MM = m

FlagBuy = False

End If

If FlagCell And Sheet.Cells(i; 4) = Empty Then

If Not FlagBuy Then

s = 0

Col = 0

SumCom = 0

ComBirga = 0

For a = MM To m - 1

Cells(a; 6) = Cells(a; 4) * Cells(a; 5) * 10

If Cells(a; 4) <> 100 Then

SumCom = SumCom + Cells(a; 4) * Cells(a; 5) * 10

ComBirga = ComBirga + _

CDbl(Format(Cells(a; 4) * Cells(a; 5) * 0,1 * Worksheets("Инфо").Cells(1; 2) + 0,001; "0,00"))

Else

Погашение = True

End If

Cells(a; 6).NumberFormat = "# ###"

s = s + Cells(a; 6)

Col = Col + Cells(a; 5)

Next a

sum = sum + s

SumBuy = s

Cells(m; 6) = s

Cells(m; 6).NumberFormat = "# ###"

Cells(m; 5) = Col

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

m = m + 1

End If

CliNum = Sheet.Cells(i; 2)

Cells(m; 2) = "Продажа"

Продажа = True

Cells(m; 2).HorizontalAlignment = xlLeft

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

m = m + 1

MM = m

FlagCell = False

End If

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

q = 2

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

If Worksheets("Бумаги").Cells(q; 1) = Cells(m; 2) Then

Cells(m; 3) = Worksheets("Бумаги").Cells(q; 3)

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

End If

q = q + 1

Wend

If Sheet.Cells(i; 4) <> Empty Then

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

Else

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

End If

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

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

m = m + 1

If CliNum <> Sheet.Cells(i + 1; 2) Or Sheet.Cells(i + 1; 1) <> CurDate Then

s = 0

Col = 0

For a = MM To m - 1

Cells(a; 6) = Cells(a; 4) * Cells(a; 5) * 10

If Cells(a; 4) <> 100 Then

SumCom = SumCom + Cells(a; 4) * Cells(a; 5) * 10

ComBirga = ComBirga + _

CDbl(Format(Cells(a; 4) * Cells(a; 5) * 0,1 * Worksheets("Инфо").Cells(1; 2) + 0,001; "0,00"))

Else

Погашение = True

End If

Cells(a; 6).NumberFormat = "# ###,00"

s = s + Cells(a; 6)

Col = Col + Cells(a; 5)

Next a

sum = sum + s

If FlagCell Then SumBuy = s

Cells(m; 6) = s

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

Cells(m; 5) = Col

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

Cells(5; 4) = CliNum

If CliNum = FilialConst Then Cells(5; 4) = DilerConst

k = 2

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

If Worksheets("Клиенты").Cells(k; 2) = CliNum Then

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

End If

k = k + 1

Wend

Range(Cells(NN - 1; 2); Cells(m; 6)).Borders(xlLeft).Weight = xlThin

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

Range(Cells(NN - 1; 2); Cells(m; 6)).Borders(xlTop).Weight = xlThin

Range(Cells(NN - 1; 2); Cells(m; 6)).Borders(xlBottom).Weight = xlThin

Range(Cells(NN - 1; 2); Cells(m; 6)).BorderAround Weight:=xlMedium

For b = 1 To BumNum

BumArray(b) = 0

BumArrayV(b) = 0

Next

b = 2

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

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

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

z = 0

For z1 = 1 To BumNum

If Worksheets("Врем").Cells(z1; 1) = Worksheets("Сделки").Cells(b; 3) Then

z = z1

Exit For

End If

Next

If z <> 0 Then

If Not IsEmpty(Worksheets("Сделки").Cells(b; 4)) Then

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

BumArrayV(z) = BumArrayV(z) + Worksheets("Сделки").Cells(b; 6)

End If

BumArray(z) = BumArray(z) + Worksheets("Сделки").Cells(b; 6)

Else

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

BumArrayV(z) = BumArrayV(z) - Worksheets("Сделки").Cells(b; 6)

End If

BumArray(z) = BumArray(z) - Worksheets("Сделки").Cells(b; 6)

End If

End If

End If

b = b + 1

Wend

' M+4

MMM = m + 5

Rows(CStr(m + 1) + ":" + CStr(m + 200)).Delete

FlagDepo = False

For b = 1 To BumNum

If BumArray(b) > 0 Or BumArrayV(b) > 0 Then

FlagDepo = True

Cells(MMM; 2) = Worksheets("Врем").Cells(b; 1)

If BumArrayV(b) < BumArray(b) Then

Cells(MMM; 4) = BumArray(b) - BumArrayV(b)

Else

If BumArrayV(b) > BumArray(b) Then

Cells(MMM; 5) = BumArrayV(b) - BumArray(b)

End If

End If

Cells(MMM; 3) = BumArrayV(b)

Cells(MMM; 6) = BumArray(b)

MMM = MMM + 1

End If

Next

If FlagDepo Then

Rows(CStr(m + 4) + ":" + CStr(m + 4)).RowHeight = 28

Rows(CStr(m + 4) + ":" + CStr(m + 4)).WrapText = True

Rows(CStr(m + 4) + ":" + CStr(m + 4)).HorizontalAlignment = xlCenter

Rows(CStr(m + 4) + ":" + CStr(m + 4)).VerticalAlignment = xlBottom

Cells(m + 4; 2) = "№ выпуска"

Cells(m + 4; 3) = "Входящий остаток"

Cells(m + 4; 4) = "Куплено"

Cells(m + 4; 5) = "Продано/ Погашено"

Cells(m + 4; 6) = "Исходящий остаток"

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

Cells(m + 2; 3) = "Количество бумаг, принадлежащих Инвестору (штук)"

Range(Cells(m + 4; 2); Cells(MMM - 1; 6)).Borders(xlLeft).Weight = xlThin

Range(Cells(m + 4; 2); Cells(MMM - 1; 6)).Borders(xlRight).Weight = xlThin

Range(Cells(m + 4; 2); Cells(MMM - 1; 6)).Borders(xlTop).Weight = xlThin

Range(Cells(m + 4; 2); Cells(MMM - 1; 6)).Borders(xlBottom).Weight = xlThin

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

End If

' ------------------------------------------------------

' - расчет остатков

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

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

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

Header:=xlYes; OrderCustom:=1; _

MatchCase:=False; Orientation:=xlTopToBottom

OstIn = 0

OstOut = 0

OstBegin = 0

OstInDate = ""

OstOutDate = ""

RowNum = 0

k = 2

DoFlag = True

Do While Ost812.Cells(k; 1) <> Empty

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

If Ost812.Cells(k; 1) < CurDate Then

OstBegin = Ost812.Cells(k; 8)

Else

Do While Ost812.Cells(k; 1) <> Empty

If Ost812.Cells(k; 2) <> CliNum Then Exit Do

If Ost812.Cells(k; 1) = CurDate Then

OstBegin = Ost812.Cells(k; 3)

OstIn = Ost812.Cells(k; 4)

OstInDate = Ost812.Cells(k; 5)

OstOut = Ost812.Cells(k; 6)

OstOutDate = Ost812.Cells(k; 7)

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

' - начало таблицы

With DialogSheets("ДиалогКлиент")

.Labels(8).Text = Cells(4; 4) ' Клиент

.Labels(9).Text = sum ' Сумма сделки

.Labels(10).Text = CurDate ' Дата текущая

.Labels(17).Text = CliNum

If CliNum = FilialConst Then .Labels(17).Text = DilerConst

.EditBoxes(1).Text = "0" ' Сумма списания

.EditBoxes(1).InputType = xlNumber

.EditBoxes(2).Text = CurDate ' Дата сделки

.EditBoxes(7).Text = OstOutDate ' списано (дата)

.EditBoxes(8).Text = OstOut ' списано (сумма)

.EditBoxes(8).InputType = xlNumber

.EditBoxes(9).Text = OstInDate ' перечислено (дата)

.EditBoxes(10).Text = OstIn ' перечислено (сумма)

.EditBoxes(10).InputType = xlNumber

Com = 0,00015

Select Case SumCom

Case Is < 36000

Com = 0,005

Case Is < 51000

Com = 0,004

Case Is < 101000

Com = 0,003

Case Is < 301000

Com = 0,002

Case Is < 501000

Com = 0,001

Case Is < 1001000

Com = 0,0005

Case Is < 3001000

Com = 0,00025

End Select

If Cells(4; 4) = "Универсалбанк" Then Com = 0

.EditBoxes(3).Text = Com ' Комиссия дилера

.EditBoxes(3).InputType = xlNumber

.EditBoxes(4).Text = "0" ' Сумма вознаграждения дилера

.EditBoxes(4).InputType = xlNumber

.EditBoxes(5).Text = "" ' Запись о вознаграждении

.EditBoxes(6).Text = OstBegin ' Остаток на 812 счете клиента

.EditBoxes(6).InputType = xlNumber

Cells(MMM + 3; 1) = "Начальник инвестиционно-аналитического отдела_________________"

Cells(MMM + 3; 6) = ""

Again:

Просмотр = False

ExitVar = False

Button = False

.Show

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

If .EditBoxes(3).Text = "" Then .EditBoxes(3).Text = 0

If .EditBoxes(4).Text = "" Then .EditBoxes(4).Text = 0

If .EditBoxes(6).Text = "" Then .EditBoxes(6).Text = 0

If .EditBoxes(8).Text = "" Then .EditBoxes(8).Text = 0

If .EditBoxes(10).Text = "" Then .EditBoxes(10).Text = 0

Cells(21; 1) = .EditBoxes(5).Text ' Запись о вознаграждении

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

Cells(6; 4) = .EditBoxes(2).Text ' Дата сделки

' занесение данных в итоговую таблицу

Cells(10; 6) = .EditBoxes(6).Text ' Входящий остаток

OstBegin = .EditBoxes(6).Text

Cells(14; 6) = SumBuy

Cells(15; 6) = sum - SumBuy

ComStr = Format(SumCom * .EditBoxes(3).Text; "0,00")

ComDiler = CDbl(ComStr)

Cells(16; 6) = ComBirga

Cells(18; 6) = ComDiler

Cells(20; 6) = .EditBoxes(4).Text

Cells(11; 6) = .EditBoxes(8).Text

OstOut = .EditBoxes(8).Text

OstIn = .EditBoxes(10).Text

Cells(12; 6) = .EditBoxes(10).Text

Cells(13; 6) = .EditBoxes(6).Text - .EditBoxes(8).Text + .EditBoxes(10).Text

Cells(11; 1) = "2.Списано на р/с / выдано наличными " + .EditBoxes(7).Text

OstInDate = .EditBoxes(9).Text

OstOutDate = .EditBoxes(7).Text

Cells(12; 1) = "3.Перечислено на покупку " + .EditBoxes(9).Text

Cells(22; 6) = 2 * SumBuy - sum + ComBirga + ComDiler

Cells(23; 6) = .EditBoxes(1).Text

Cells(24; 6) = .EditBoxes(6).Text - .EditBoxes(8).Text + .EditBoxes(10).Text - _

(2 * SumBuy - sum + ComBirga + ComDiler) - _

.EditBoxes(1).Text - .EditBoxes(4).Text

OstEnd = Cells(24; 6)

Ost812.Cells(k; 1) = CurDate

Ost812.Cells(k; 2) = CliNum

Ost812.Cells(k; 3) = OstBegin

Ost812.Cells(k; 4) = OstIn

Ost812.Cells(k; 5) = OstInDate

Ost812.Cells(k; 6) = OstOut

Ost812.Cells(k; 7) = OstOutDate

Ost812.Cells(k; 8) = OstEnd

Ost812.Cells(k; 9) = Cells(14; 6) + Cells(15; 6)

Ost812.Cells(k; 10) = Cells(16; 6)

Ost812.Cells(k; 11) = Cells(18; 6)

Call EditOstBirga(CliNum)

' конец занесения данных

If Просмотр Then

Worksheets("ОтчетыИнвесторам").PrintPreview

GoTo Again

End If

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

If ExitVar Then Exit Sub

End With

' печать мемориальных ордеров

Dim StrS As String

Auk = False

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 = "Покупка / Погашение"

If .OptionButtons(5).Value = xlOn Then Auk = True

End With

Worksheets("Ордер").Select

Dim Pos812 As Integer

Dim Page; Page1 As Object

Set Page = Worksheets("ОтчетыИнвесторам")

Set Page1 = Worksheets("Клиенты")

Pos812 = 2

While (Page1.Cells(Pos812; 1) <> Empty) And (Worksheets("Клиенты").Cells(Pos812; 2) <> CliNum)

Pos812 = Pos812 + 1

Wend

If Page.Cells(14; 6) - Page.Cells(15; 6) > 0 Then

If MemoOrder(Index; Page.Cells(14; 6) - Page.Cells(15; 6); 6; 7; Pos812; _

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

Index = Index + 1

Else

If MemoOrder(Index; Page.Cells(15; 6) - Page.Cells(14; 6); 7; 6; Pos812; _

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

Index = Index + 1

End If

Dim SumS As Double

SumS = Page.Cells(16; 6) + Page.Cells(18; 6) + Page.Cells(20; 6)

If SumS > 0 Then

StrS = ""

If Page.Cells(18; 6) > 0 Then StrS = "Комиссия Дилера " + CStr(Page.Cells(18; 6)) + " в т.ч. НДС " + _

CStr(Format(Page.Cells(18; 6) / 6; "0,00"))

If Page.Cells(16; 6) > 0 And Not Auk Then StrS = StrS + " возмещение ком. ВКБ " + CStr(Page.Cells(16; 6)) + " в т.ч. НДС " + _

CStr(Format(Page.Cells(16; 6) / 6; "0,00"))

If CliNum = FilialConst Then

If MemoOrder(Index; SumS; 6; 7; Pos812; StrS) Then Exit Sub

Else

If Auk Then

StrS = StrS + " по приобретению на аукционе"

If MemoOrder(Index; Page.Cells(18; 6) + Page.Cells(20; 6); 6; 12; Pos812; StrS) Then Exit Sub

StrS = "Возмещение ком. ВКБ " + CStr(Page.Cells(16; 6)) + " в т.ч. НДС " + _

CStr(Format(Page.Cells(16; 6) / 6; "0,00"))

Index = Index + 1

If MemoOrder(Index; Page.Cells(16; 6); 6; 8; Pos812; StrS) Then Exit Sub

Else

If MemoOrder(Index; SumS; 6; 8; Pos812; StrS) Then Exit Sub

End If

End If

Index = Index + 1

End If

If CliNum <> FilialConst Then

If Len(StrComS) > 0 Then

StrComS = StrComS + "," + CStr(Right(CliNum; 3))

Else

StrComS = StrComS + CStr(Right(CliNum; 3))

End If

End If

If CliNum <> FilialConst Then ComSum = ComSum + Page.Cells(16; 6)

Worksheets("ОтчетыИнвесторам").Select

'---------------

Rows(CStr(m + 4) + ":" + CStr(m + 4)).RowHeight = 13,8

Rows(CStr(m + 4) + ":" + CStr(m + 4)).WrapText = False

Rows(CStr(m + 4) + ":" + CStr(m + 4)).HorizontalAlignment = xlRight

Rows(CStr(m + 4) + ":" + CStr(m + 4)).VerticalAlignment = xlBottom

Range(Cells(NN; 2); Cells(NN + 200; 6)).Delete shift:=xlToLeft

m = NN

FlagBuy = True

FlagCell = True

ComBirga = 0

sum = 0

SumBuy = 0

SumCom = 0

End If

End If

i = i + 1

Loop

If Not FlagDeal Then

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

Else

If ComSum > 0 Then

Worksheets("Ордер").Select

If MemoOrder(Index; ComSum; 9; 7; 2; _

"Комиссия ВКБ по инвесторам " + StrComS + " в т.ч. НДС " + _

CStr(Format(ComSum / 6; "0,00"))) Then Exit Sub

End If

End If

End Sub

'-------------------------------- Печать Отчеты недельные ----------

Sub PrintOtchWeek()

Dim BumNum; CliNum; i; j; k; a; n; Sign; s As Integer

Dim Flag As Boolean

Dim Code As Long

Dim Str As String

Dim DepoFil() As Integer

Dim Num As Integer

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

Call FormBum

Sheets("ОтчетНедельный").Select

BumNum = Worksheets("Врем").Cells(1; 2)

Num = 8

For i = 1 To BumNum

Cells(6; i + 1) = Worksheets("Врем").Cells(i; 1)

Cells(6; i + 1).Font.Bold = True

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

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

Cells(Num; i + 1) = ""

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

Next

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

Cells(Num; 1) = ""

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

Cells(5; 1) = ""

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

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

Cells(6; 1) = "№ бумаги"

Cells(7; 1) = "Дилер"

Cells(6; 1).HorizontalAlignment = xlCenter

Cells(7; 1).HorizontalAlignment = xlCenter

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

CliNum = Worksheets("Врем").Cells(1; 3)

ReDim DepoArray(CliNum; BumNum)

a = 2

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

i = 1

While Worksheets("Клиенты").Cells(i + 1; 2) <> _

Worksheets("Сделки").Cells(a; 2)

If Worksheets("Клиенты").Cells(i + 1; 2) = Empty Then

MsgBox "Неверный номер клиента в Окне 'Сделки'"

Exit Sub

End If

i = i + 1

Wend

k = 0

For j = 1 To BumNum

If Worksheets("Врем").Cells(j; 1) = Worksheets("Сделки").Cells(a; 3) Then

k = j

Exit For

End If

Next

If k = 0 Then

a = a + 1

GoTo NNN

End If

If Not IsEmpty(Worksheets("Сделки").Cells(a; 4)) Then

Sign = 1

Else

Sign = -1

End If

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

DepoArray(i; k) = DepoArray(i; k) + Sign * Worksheets("Сделки").Cells(a; 6)

End If

a = a + 1

NNN:

Wend

For k = 1 To BumNum

DepoArray(1; k) = DepoArray(1; k) + DepoArray(2; k)

DepoArray(2; k) = 0

Next k

n = 7

For i = 1 To CliNum

Flag = False

For k = 1 To BumNum

If DepoArray(i; k) > 0 Then Flag = True

Next

If Flag Then

If n > 7 Then

Str = Format(Worksheets("Клиенты").Cells(i + 1; 2); "0000000000")

Str = Right(Str; 5)

Cells(n; 1).NumberFormat = "@"

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

Cells(n; 1).HorizontalAlignment = xlCenter

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

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

Cells(n; 1) = Str

End If

For k = 1 To BumNum

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) <= DateEnd 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; 7) <> "списание" 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 And Sheet.Cells(i; 3) > 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) <= CurDate Then

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

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

i = 2

While Cells(i; 1) <= CurDate And 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"

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

Dim Sheet As Object

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 And Sheet.Cells(i; 3) >= 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 And L.Cells(i; 3) >= 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. Журнал оборотов.

Приложение № 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 ' максимальное количество бумаг в портфеле одной серии

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

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

Ind = ReturnBum(Sheet.Cells(i; 3))

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

Portfel.EndPos(Ind) = Portfel.EndPos(Ind) + 1

Portfel.Dates(Ind; Portfel.EndPos(Ind)) = Sheet.Cells(i; 1)

Portfel.Price(Ind; Portfel.EndPos(Ind)) = Sheet.Cells(i; 4)

Portfel.Volume(Ind; Portfel.EndPos(Ind)) = Sheet.Cells(i; 6)

Portfel.VolumeAll(Ind) = Portfel.VolumeAll(Ind) + Sheet.Cells(i; 6)

Else

SumCell = Sheet.Cells(i; 6)

Portfel.VolumeAll(Ind) = Portfel.VolumeAll(Ind) - Sheet.Cells(i; 6)

While SumCell >= 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 <= Sheet.Cells(i; 1) And Sheet.Cells(i; 1) <> CurDate Then

Call Процедура_анализа(Sheet.Cells(i; 1))

CoefIndex = CoefIndex + 1

RevIndex = RevIndex + 1

CurDate = Sheet.Cells(i; 1)

End If

i = i + 1

Wend

If Analize1 Then

Worksheets("РезультатИндекс").Cells(1; 2) = "Портфель"

Worksheets("РезультатИндекс").Cells(1; 3) = "Рынок"

For i = 1 To CoefIndex - 1

Worksheets("РезультатИндекс").Cells(i + 1; 1) = Index(i).Dates

Worksheets("РезультатИндекс").Cells(i + 1; 2) = Index(i).Portfel

Worksheets("РезультатИндекс").Cells(i + 1; 3) = Index(i).Birga

Next i

Charts("ДиаграммаИндекс").ChartWizard Source:=Sheets("РезультатИндекс").Range( _

"A1:C" + CStr(i)); Gallery:=xlLine; Format:=4; PlotBy:=xlColumns; _

CategoryLabels:=1; SeriesLabels:=1; HasLegend:=1; Title:= _

"Сравнение индекса портфеля и рынка"; CategoryTitle:="дата"; ValueTitle:= _

"индекс"; ExtraTitle:=""

Charts("ДиаграммаИндекс").Select

MsgBox "Диаграмма Индекса"

End If

If Analize2 Then

Worksheets("РезультатДоходность").Cells(1; 2) = "Портфель"

Worksheets("РезультатДоходность").Cells(1; 3) = "Рынок"

For i = 1 To RevIndex - 1

Worksheets("РезультатДоходность").Cells(i + 1; 1) = Revenue(i).Dates

Worksheets("РезультатДоходность").Cells(i + 1; 2) = Revenue(i).Portfel

Worksheets("РезультатДоходность").Cells(i + 1; 3) = Revenue(i).Birga

Next i

Charts("ДиаграммаДоходность").ChartWizard Source:=Sheets("РезультатДоходность").Range( _

"A1:C" + CStr(i)); Gallery:=xlLine; Format:=4; PlotBy:=xlColumns; _

CategoryLabels:=1; SeriesLabels:=1; HasLegend:=1; Title:= _

"Сравнение доходности портфеля и рынка"; CategoryTitle:="дата"; ValueTitle:= _

"доходность"; ExtraTitle:=""

Charts("ДиаграммаДоходность").Select

MsgBox "Диаграмма Доходности"

End If

End Sub

'--------------------- функция возвращает индекс бумаги в массиве BumInfo -------------

Function ReturnBum(bum As Long)

Dim i As Integer

For i = 1 To BumNum

If bum = BumInfo(i).Num Then

ReturnBum = i

Exit Function

End If

Next i

MsgBox "Не найдена бумага в списке бумаг. Занести бумагу в лист Бумаги"

End

End Function

'-------------------- Процедура построения индексов портфеля и рынка -----------------

Sub Процедура_анализа(CurDate As Date)

Dim i; k As Long

Dim Sheet As Object

Dim PortfelPrice; BirgaPrice As Single

Dim BirgaCoef; PortfelCoef As Single

Dim Doh; Volume As Single

Dim Flag As Boolean

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

' поиск первой строки начала биржевой информации за текущий день

i = Поиск(Worksheets("Биржа"); 1; 2; CurDate; 1)

If i = 0 Then

'MsgBox "Биржевая информация за " + CStr(CDate(CurDate)) + "не найдена"

'End

CoefIndex = CoefIndex - 1

Exit Sub

End If

' занесение биржевой информации за текущий день

If i <> 0 Then

While Sheet.Cells(i; 1) = CurDate

If Sheet.Cells(i; 6) <> Empty Then

BirgaInfo(ReturnBum(Sheet.Cells(i; 2))) = Sheet.Cells(i; 6)

End If

i = i + 1

Wend

End If

' определение по каждой бумаге обращения на бирже

For i = 1 To BumNum

If BumInfo(i).DateStart <= CurDate And CurDate <= BumInfo(i).DateEnd Then

BumInfo(i).Present = True

Else

BumInfo(i).Present = False

End If

Next i

' если выбран анализ эффективной доходности портфеля и рынка

If Analize2 Then

Doh = 0

Volume = 0

Flag = True

For k = 1 To BumNum

If BumInfo(k).Present Then

For i = Portfel.StartPos(k) To Portfel.EndPos(k)

Flag = False

Doh = Doh + (100 / Portfel.Price(k; i) - 1) * 36500 * Portfel.Volume(k; i)

Volume = Volume + Portfel.Volume(k; i) * (BumInfo(k).DateEnd - Portfel.Dates(k; i))

Next i

End If

Next k

If Flag Then

RevIndex = RevIndex - 1

GoTo Anal1

End If

Revenue(RevIndex).Portfel = Doh / Volume

Revenue(RevIndex).Dates = CurDate

Flag = True

Doh = 0

Volume = 0

For k = 1 To BumNum

If BumInfo(k).Present Then

Flag = False

Doh = Doh + (100 / BirgaInfo(k) - 1) * 36500 * BumInfo(k).Volume

Volume = Volume + BumInfo(k).Volume * (BumInfo(k).DateEnd - CurDate)

End If

Next k

If Flag Then

RevIndex = RevIndex - 1

GoTo Anal1

End If

Revenue(RevIndex).Birga = Doh / Volume

End If

Anal1:

' если выбран анализ индекса портфеля и рынка

If Analize1 Then

' определение стоимости портфеля и биржи по средневзвешенным ценам

PortfelPrice = 0

BirgaPrice = 0

For i = 1 To BumNum

PortfelPrice = PortfelPrice + Portfel.VolumeAll(i) * BirgaInfo(i) * 10000

BirgaPrice = BirgaPrice + BumInfo(i).Volume * BirgaInfo(i) * 10000

Next i

' расчет индексов

If CoefIndex <> 1 Then

' поиск остатков за текущий день

k = Поиск(Worksheets("Остаток"); 1; 2; CurDate; 1)

If k <> 0 Then

PortfelPrice = PortfelPrice + Worksheets("Остаток").Cells(k; 2)

End If

' вычисление коэффициента портфеля

If k <> 0 Then

PortfelCoef = (PortfelPrice - Worksheets("Остаток").Cells(k; 3) _

+ Worksheets("Остаток").Cells(k; 4)) / PortfelPricePred

Else

PortfelCoef = PortfelPrice / PortfelPricePred

End If

PortfelPricePred = PortfelPrice

' определение индекса портфеля за текущий день

Index(CoefIndex).Portfel = Index(CoefIndex - 1).Portfel * PortfelCoef

Index(CoefIndex).Dates = CurDate

BirgaCoef = BirgaPrice

k = Поиск(Worksheets("Бумаги"); 2; 2; CurDate; 1)

If k <> 0 Then

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

End If

k = Поиск(Worksheets("Бумаги"); 3; 2; CurDate; 1)

If k <> 0 Then

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

End If

BirgaCoef = BirgaCoef / BirgaPricePred

BirgaPricePred = BirgaPrice

' определение индекса биржи за текущий день

Index(CoefIndex).Birga = Index(CoefIndex - 1).Birga * BirgaCoef

Else

k = Поиск(Worksheets("Остаток"); 1; 2; CurDate; 1)

If k <> 0 Then

PortfelPrice = PortfelPrice + Worksheets("Остаток").Cells(k; 2)

End If

PortfelPricePred = PortfelPrice

BirgaPricePred = BirgaPrice

End If

End If

End Sub

Sub Cancel()

End

End Sub

Приложение № 2.2. Диаграмма сравнения доходности портфеля и рынка.

Приложение № 2.3. Диаграмма сравнения индекса портфеля и рынка.

Приложение № 3. Входные статистические данные.

Приложение 3.1. Информация о бумагах.