|
Анализ эффективности вложений денежных средств в РКОp> Rows(CStr(NN - 1) + ":" + CStr(NN - 1)).WrapText = TrueRows(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 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 * 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) 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 * 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 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) = 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; 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; 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 Range(Cells(m + 4; 2); Cells(MMM - 1; Range(Cells(m + 4; 2); Cells(MMM - 1; 6)).Borders(xlTop).Weight Range(Cells(m + 4; 2); Cells(MMM - 1; Range(Cells(m + 4; 2); Cells(MMM - 1; 6)).BorderAround End If ' ------------------------------------------------------ ' - расчет остатков Set Ost812 = Worksheets("Остатки812") Ost812.Range("B2").Sort Key1:=Ost812.Range("B2"); Key2:=Ost812.Range("A2"); 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 + Cells(11; 1) = "2.Списано на р/с / выдано наличными " + 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 + (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 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; StrS + " РКО за " + CStr(CurDate)) Then Exit Sub Index = Index + 1 Else If MemoOrder(Index; Page.Cells(15; 6) - Page.Cells(14; 6); 7; 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(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); 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) 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; 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; 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 * 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 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 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) (Sheet.Cells(i; 2) < DateEnd And Sheet.Cells(i; 3) > DateEnd) Or (Sheet.Cells(i; 2) > DateBegin And Sheet.Cells(i; 3) < DateEnd) 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; End If If Cells(i; 1) >= DateBegin And DateFlag Then For k = 1 To NumberClients For m = 1 To BumNum mas(k; (m - 1) * 7 + 2) = mas(k; (m - 1) * 7 + 1) Next m Next k DateFlag = False End If If Cells(i; 1) >= DateBegin And Cells(i; 1) 0 Or _ mas(i; (k - 1) * 7 + 2) > 0 Or _ mas(i; (k - 1) * 7 + 3) > 0 Or _ mas(i; (k - 1) * 7 + 4) > 0 Or _ mas(i; (k - 1) * 7 + 5) > 0 Or _ mas(i; (k - 1) * 7 + 6) > 0 Or _ mas(i; (k - 1) * 7 + 7) > 0 Then CliInput(i) = True Next k Next i For k = 1 To BumNum BumInput(k) = False For i = 1 To NumberClients If mas(i; (k - 1) * 7 + 1) > 0 Or _ mas(i; (k - 1) * 7 + 2) > 0 Or _ mas(i; (k - 1) * 7 + 3) > 0 Or _ mas(i; (k - 1) * 7 + 4) > 0 Or _ mas(i; (k - 1) * 7 + 5) > 0 Or _ mas(i; (k - 1) * 7 + 6) > 0 Or _ mas(i; (k - 1) * 7 + 7) > 0 Then BumInput(k) = True Next i Next k Worksheets("ОтчетМесячный").Select Range(Cells(7; 1); Cells(800; 22)).Delete shift:=xlToLeft Row = 4 Col = 2 Cells(2; 1) = "за период от " + CStr(DateBegin) + " до " + 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 Range(Cells(7; 9); Cells(Num + 7; 15)).BorderAround 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) + " до " + 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"); 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"); Header:=xlYes; OrderCustom:=1; _ MatchCase:=False; Orientation:=xlTopToBottom Sheet1.Range("B2").Sort Key1:=Sheet1.Range("B2"); Key2:=Sheet1.Range("A2"); 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) 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); ReDim BumVol(BumNum) For i = 1 To BumNum dates(i) = 1 Next i i = 2 While Cells(i; 1) Empty If Cells(i; 2) = DilerConst And Cells(i; 7) "списание" _ And Cells(i; 7) "зачисление" Then Flag = True For k = 1 To BumNum ' поиск номера бумаги If Cells(i; 3) = Bum(k) Then Flag = False Exit For End If Next k If Flag Then GoTo cont If Cells(i; 1) Volume(k; i) Then V(k) = V(k) - Volume(k; i) Else Volume(k; i) = V(k) BeginIndex(k) = i Exit For End If Next i Next k For k = 1 To BumNum BumIndex(k) = False If V(k) > 0 Then BumIndex(k) = True Next k i = 2 While Cells(i; 1) 0 Then BumPrice(k) = Sheet.Cells(i; 6) Else BumPrice(k) = 0 End If End If Next k End If i = i + 1 Wend If Flag Then MsgBox "Биржевой информации нет. Портфель сформировать невозможно." Exit Sub End If Worksheets("Портфель1").Select Cells(4; 3) = CurDate Range("A7:H200").Delete shift:=xlToLeft m = 7 PortfelCost = 0 PortfelBalance = 0 For k = 1 To BumNum If Volume(k; BeginIndex(k)) > 0 Then For i = BeginIndex(k) To dates(k) If Volume(k; i) > 0 Then Cells(m; 1) = Bum(k) Cells(m; 1).NumberFormat = "0" Cells(m; 2) = DateMas(k; i) Cells(m; 2).NumberFormat = "ДД.ММ.ГГ" Cells(m; 3) = Price(k; i) Cells(m; 3).NumberFormat = "0,00" Cells(m; 4) = Volume(k; i) Cells(m; 4).NumberFormat = "0" DohPog(k; i) = (100 / Price(k; i) - 1) * 36500 / (DatePog(k) - 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 / 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) * 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) * SumPriobr2(k) = SumPriobr2(k) + Volume(k; i) * (CurDate - 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) 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) "списание") 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) * Else If Cells(i; 5) 100 Then ComMas(k) = ComMas(k) + Format(Cells(i; 5) * Cells(i; 6) * 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) 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)) End If If Mag(2) < 0 Then If MemoOrder(i; min(Mag(3); Mag(2)); SR970; S904; 0; _ "Отрицательная разница от продажи РКО за " + CStr(CurDate)) 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 End If End Sub '-------------------------------------------- Memo Order Function MemoOrder(Num; sum As Double; n1; n2; Pos As Integer; Order 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) * Cells(n; 15) = (100 / Cells(n; 10) - 1) * 36500 / Cells(n; 5) Cells(n; 16) = (100 / Cells(n; 11) - 1) * 36500 / Cells(n; 5) * Cells(n; 16).Font.Bold = True Cells(n; 17) = (100 / Cells(n; 11) - 1) * 36500 / Cells(n; 5) mas(1) = mas(1) + Cells(n; 5) * Cells(n; 9) * Cells(n; 14) mas(2) = mas(2) + Cells(n; 5) * Cells(n; 9) * Cells(n; 16) mas(3) = mas(3) + Cells(n; 5) * Cells(n; 9) End If n = n + 1 End If i = i + 1 Loop If Flag Then MsgBox "Биржевой информации нет" Exit Sub End If Num = n Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlLeft).Weight = xlThin Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlRight).Weight = xlThin Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlTop).Weight = xlThin Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlBottom).Weight = xlThin Range(Cells(7; 1); Cells(Num - 1; 17)).BorderAround Weight:=xlMedium Cells(Num; 1) = "Итого" Cells(Num; 1).Font.Bold = True Cells(Num; 1).HorizontalAlignment = xlCenter Cells(Num; 14) = mas(1) / mas(3) Cells(Num; 15) = mas(1) / mas(3) / 0,85 Cells(Num; 16) = mas(2) / mas(3) Cells(Num; 16).Font.Bold = True Cells(Num; 17) = mas(2) / mas(3) / 0,85 Range(Cells(Num; 14); Cells(Num; 17)).NumberFormat = "0,00" For i = 1 To 3 mas(i) = 0 Next i For i = 7 To Num - 1 mas(1) = mas(1) + Cells(i; 6) mas(2) = mas(2) + Cells(i; 7) mas(3) = mas(3) + Cells(i; 9) Next Cells(Num; 6) = mas(1) Cells(Num; 6).NumberFormat = "# ##0" Cells(Num; 7) = mas(2) Cells(Num; 9) = mas(3) Cells(Num; 9).NumberFormat = "# ##0" Cells(Num; 8) = mas(3) / mas(1) * 100 Cells(Num; 8).NumberFormat = "0,00" Cells(Num; 7).Font.Bold = True Cells(Num; 9).Font.Bold = True Range(Cells(Num; 1); Cells(Num; 17)).BorderAround Weight:=xlMedium Range(Cells(Num; 1); Cells(Num; 17)).Interior.ColorIndex = 15 If DialogPrint("Биржевая Информация"; 1) Then Exit Sub End Sub '-------------------------------- Дата ----------------------------- Sub DateChange() With DialogSheets("ДиалогДата") .EditBoxes.Text = CurDate .EditBoxes.InputType = 1 .Show CurDate = Worksheets("Врем").Cells(1; 4) If Button = False Then CurDate = Date Worksheets("Врем").Cells(1; 4) = CurDate MsgBox "Дата восстановлена" Else If IsDate(.EditBoxes.Text) Then CurDate = .EditBoxes.Text MsgBox "Дата изменена" Worksheets("Врем").Cells(1; 4) = CurDate Exit Sub End If MsgBox "Ошибка при вводе даты" End If End With End Sub '-------------------------------- Формирование текущей таблицы бумаг -- Sub FormBum() Dim L As Object Dim i; k As Integer Set L = Worksheets("Бумаги") CurDate = Worksheets("Врем").Cells(1; 4) i = 2 k = 1 While L.Cells(i; 1) Empty If L.Cells(i; 2) = CurDate Then Worksheets("Врем").Cells(k; 1) = L.Cells(i; 1) k = k + 1 End If i = i + 1 Wend Worksheets("Врем").Cells(1; 2) = k - 1 Set L = Worksheets("Клиенты") i = 1 While L.Cells(i; 1) Empty i = i + 1 Wend Worksheets("Врем").Cells(1; 3) = i - 2 End Sub ' ------------------------------- Остатки на бирже -------------------- Sub EditOstBirga(CliNum As Long) Dim ComBirga; sum; OstBegin As Double Dim DoFlag As Boolean Dim Sheet; Sheet1 As Object Dim i; k; RowNum As Long Set Sheet = Worksheets("ОстаткиБиржа") Set Sheet1 = Worksheets("Сделки") CurDate = Worksheets("Врем").Cells(1; 4) ComBirga = Worksheets("Инфо").Cells(1; 2) Sheet.Range("B2").Sort Key1:=Sheet.Range("B2"); Order1:=xlAscending; Key2:=Sheet.Range("A2"); 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 + 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 + End If End If i = i + 1 Wend Sheet.Cells(k; 3) = OstBegin Sheet.Cells(k; 6) = OstBegin + sum + Sheet.Cells(k; 4) Sheet.Cells(k; 1) = CurDate Sheet.Cells(k; 2) = CliNum End Sub Sub Ok() Button = True End Sub Sub Cancel() Button = False End Sub Sub ПросмотрОтчетов() Просмотр = True End Sub Sub Останов() ExitVar = True End Sub Sub EndOf() Dim i As Long i = 2 While Cells(i; 1) Empty i = i + 1 Wend Cells(i; 1).Select End Sub Function DialogPrint(Str As String; Count As Integer) With DialogSheets("ДиалогПечать") AgainView: Просмотр = False ExitVar = False Button = False .Show If Просмотр Then Worksheets(Str).PrintPreview GoTo AgainView End If If ExitVar Then DialogPrint = True Else DialogPrint = False End If If Button Then ActiveWindow.SelectedSheets.PrintOut copies:=Count End With End Function Function min(a; b) If Abs(a) > Abs(b) Then min = Abs(b) Else min = Abs(a) End If End Function Приложение № 1.3. Журнал оборотов. [pic] Приложение № 1.4. Журнал лицевого учета. [pic] Приложение № 1.5. Мемориальный ордер. [pic] Приложение № 1.6. Отчет инвестору о совершенных сделках. [pic] Приложение № 1.7. Структура пртфеля в разрезе по бумагам. [pic] Приложение № 1.8. Структура портфеля обобщенная. [pic] Приложение № 1.9. Биржевая информация. [pic] Приложение № 1.10. Еженедельный отчет в депозитарий. [pic] Приложение № 1.11. Ежемесячный отчет в депозитарий. [pic] Приложение № 2. Программа анализа эффективности вложений в РКО. Приложение 2.1. Текст программы. Option Explicit Option Base 1 '*************************** Сортировка ************************* ' Процедура сортировки страницы ' Параметры: ' Sheet - лист ' RangeSort - первая ячейка для сортировки ' StrKey1 - сортировка сначала производится по этому столбцу ' StrKey2 - а затем по этому ' StrKey3 - и по этому в последнюю очередь ' OrderType1 - Направление сортировки по столбцу StrKey1 ' OrderType2 - Направление сортировки по столбцу StrKey2 ' OrderType3 - Направление сортировки по столбцу StrKey3 ' Пример использования : ' Call Сортировка(Worksheets("Биржа"); "A2"; "A2"; "B2"; "C2"; xlAscending; xlDescending; xlAscending) '***************************************************************** Sub Сортировка(Sheet As Object; RangeSort As String; StrKey1 As StrKey2 As String; StrKey3 As String; TypeOrder1 As Integer; Sheet.Range(RangeSort).Sort Key1:=Sheet.Range(StrKey1); Sheet.Range(StrKey2); Order2:=TypeOrder2; 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; 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) + "Данные разных типов в столбце базы" + End End Function Option Explicit Option Base 1 ' ---------------------------- Общая часть ---------------------------- ' внешние параметры ' тип данных для записи информации о бумаге Type BumRecord Num As Long ' номер бумаги DateStart As Date ' дата выпуска DateEnd As Date 'дата погашения Volume As Long 'объем выпуска Present As Boolean End Type ' тип данных для записи информации о структуре портфеля Type PortfelRecord Dates() As Date ' дата покупки Price() As Single ' цена покупки Volume() As Long ' количество StartPos() As Integer ' начальный индекс бумаги в массиве бумаг данной серии EndPos() As Integer ' конечный индекс бумаги в массиве бумаг данной серии VolumeAll() As Long ' количество бумаг данной серии в портфеле End Type ' тип данных для записи информации об индксах портфеля и рынка Type IndexRecord Dates As Date Portfel As Single Birga As Single End Type Const MaxBum = 500 ' максимальное количество бумаг в портфеле одной серии Const DilerConst = 1000900000 ' константа для выборки портфеля дилера Dim MaxPeriod As Long ' максимальное количество дней для анализа(можно вычислить как последний день анализа-первый день анализа+1) Dim Portfel As PortfelRecord ' данные о портфеле Dim BumInfo() As BumRecord ' данные о бумагах Dim BumNum As Integer ' количество различных серий бумаг Dim Index() As IndexRecord ' индексы портфеля и рынка Dim Revenue() As IndexRecord ' доходность к погашению портфеля и рынка Dim BirgaInfo() As Single ' текущая биржевая информация по каждой серии Dim CoefIndex As Long ' индекс коэффициента Dim RevIndex As Long ' индекс доходности Dim EvalDate As Date ' дата для расчета Dim StartDate As Date ' начальная дата для постоения индексов Dim PortfelPricePred; BirgaPricePred As Single Dim Analize1; Analize2 As Boolean '------------------------------- Процедура расчета портфеля (главный модуль)- Sub АнализПортфель() Dim Sheet As Object Dim i; Ind As Integer Dim SumCell As Long Dim CurDate As Date Set Sheet = Worksheets("Бумаги") BumNum = 0 While Sheet.Cells(BumNum + 2; 1) Empty BumNum = BumNum + 1 Wend With DialogSheets("ДиалогДата") .EditBoxes(1).Text = "05.02.97" .EditBoxes(2).Text = "30.05.97" .EditBoxes(1).InputType = xlDate .EditBoxes(2).InputType = xlDate .Show StartDate = CDate(.EditBoxes(1).Text) EvalDate = CDate(.EditBoxes(2).Text) End With With DialogSheets("ДиалогВыбор") again: .Show Analize1 = False Analize2 = False If .CheckBoxes(1).Value = 1 Then Analize1 = True If .CheckBoxes(2).Value = 1 Then Analize2 = True If Not Analize1 And Not Analize2 Then MsgBox "Выберите тип анализа" GoTo again End If End With MaxPeriod = EvalDate - StartDate + 1 ReDim Index(MaxPeriod) ReDim Revenue(MaxPeriod) Index(1).Portfel = 1 Index(1).Birga = 1 Index(1).Dates = StartDate ReDim BumInfo(BumNum) ReDim BirgaInfo(BumNum) For i = 1 To BumNum With BumInfo(i) .Num = Sheet.Cells(i + 1; 1) .DateStart = Sheet.Cells(i + 1; 2) .DateEnd = Sheet.Cells(i + 1; 3) .Volume = Sheet.Cells(i + 1; 4) End With Next i ReDim Portfel.Dates(BumNum; MaxBum) ReDim Portfel.Price(BumNum; MaxBum) ReDim Portfel.Volume(BumNum; MaxBum) ReDim Portfel.StartPos(BumNum) ReDim Portfel.EndPos(BumNum) ReDim Portfel.VolumeAll(BumNum) For i = 1 To BumNum Portfel.StartPos(i) = 1 Portfel.EndPos(i) = 0 Next i Set Sheet = Worksheets("Сделки") Call Сортировка(Worksheets("Сделки"); "A2"; "A2"; "B2"; "D2"; _ xlAscending; xlAscending; xlAscending) i = 2 CoefIndex = 1 RevIndex = 1 CurDate = StartDate While Sheet.Cells(i; 1) Empty And Sheet.Cells(i; 1) = Portfel.Volume(Ind; Portfel.StartPos(Ind)) And SumCell = 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; End If End If End If ' в данном месте можео провести анализ на основе данных о портфеле за текущую дату ' дата текущая - это Worksheets("Сделки").cells(i-1;1) ' т.е. анализ за эту текущую дату(доходность к погашению портфеля, индекс,...) If StartDate Страницы: 1, 2 |
|
