Анализ эффективности вложений денежных средств в РКО
p> 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
Страницы: 1, 2, 3, 4, 5
|