Содержание.
Введение.
Глава 1. Функционирование рынка РКО.
Участники рынка.
Процедура торгов.
Первичное размещение (аукцион).
Вторичные торги.
Погашение.
Документооборот.
Отчеты, предоставляемые биржей.
Отчеты, предоставляемые Дилерами.
Глава 2. Задачи Дилера на рынке РКО.
Ведение бэк-офиса.
Оптимизация вложений собственных средств.
Управление средствами инвесторов.
Исполнение поручений Инвесторов.
Анализ эффективности вложений.
Глава 3. Задачи формирования и ведения собственного портфеля облигаций Дилера.
Формирование портфеля облигаций.
Ликвидность портфеля.
Период инвестирования.
Инвестирование с целью максимизации дохода.
Безрисковое инвестирование.
Анализ эффективности вложений денежных средств в РКО.
Постановка задачи.
Метод решения.
Экономическая интерпретация метода.
Экономическая интерпретация полученных результатов.
Применение результатов исследования для построения методов эффективного управления портфелем облигаций.
Заключение.
Список литературы.
Приложения.
Приложение № 1. Программа автоматизации учета РКО.
Приложение 1.1. Руководство пользователя.
Приложение 1.2. Текст программы.
Приложение № 1.3. Журнал оборотов.
Приложение № 1.4. Журнал лицевого учета.
Приложение № 1.5. Мемориальный ордер.
Приложение № 1.6. Отчет инвестору о совершенных сделках.
Приложение № 1.7. Структура пртфеля в разрезе по бумагам.
Приложение № 1.8. Структура портфеля обобщенная.
Приложение № 1.9. Биржевая информация.
Приложение № 1.10. Еженедельный отчет в депозитарий.
Приложение № 1.11. Ежемесячный отчет в депозитарий.
Приложение № 2. Программа анализа эффективности вложений в РКО.
Приложение 2.1. Текст программы.
Приложение № 2.2. Диаграмма сравнения доходности портфеля и рынка.
Приложение № 2.3. Диаграмма сравнения индекса портфеля и рынка.
Приложение № 3. Входные статистические данные.
Приложение 3.1. Информация о бумагах.
Приложение 3.2. Информация о сделках.
Приложение 3.3. Информация о движениях денежных средств.
Приложение 3.4. Биржевая информация.

Введение.

Республиканские краткосрочные бескупонные облигации (РКО) выпускаются Министерством Финансов Республики Татарстан. Рынок РКО существует с 1995 года. За три года он стал важнейшим сегментом в экономике Татарстана, сравнимый по объему заимствований с рынком межбанковских кредитов и иностранной валюты.
Гарантом надежности вложений в РКО является Правительство РТ. РКО - ликвидный и наиболее доходный инструмент финансового рынка. Доходность по РКО выше, чем по банковским вкладам и депозитным сертификатам, а также государственным ценным бумагам. Имея льготное налогообложение, РКО является наиболее привлекательным вложением свободных финансовых ресурсов.
Вкладывать средства в РКО могут как юридические, так и физические лица. Доход по этим облигациям получается от разницы между ценой покупки и продажи, т.е. дисконт.
РКО обращаются в бездокументарной форме и учитываются записями по счетам депо. Продажа и покупка производится на фондовой бирже. В связи с этим возникает задача учета операций с РКО как со стороны биржи, так и со стороны организаций-инвесторов.
На данном сегменте фондового рынка можно производить как краткосрочные спекулятивные операции, так и долгосрочные вложения свободных собственных или заемных средств. Таким образом, актуальной является задача оценки эффективности вложений в РКО.
В данной дипломной работе решаются две задачи:
1. Автоматизация учета операций с РКО;
2. Оценка эффективности вложений в РКО.
На основе результатов второй задачи можно будет сделать некоторые выводы для оптимизации принятия решений при вложении в бескупонные облигации.

Глава 1. Функционирование рынка РКО.

Республиканские краткосрочные облигации обращаются на Волжско-Камской бирже (ВКБ) посредством проведения электронных торгов. В функционировании рынка РКО можно выделить следующие моменты:

1. Участники рынка.
2. Процедура торгов.
3. Документооборот.

Участники рынка.

Участники рынка разделяются на две категории: Дилеры и инвесторы.
Дилер - любое юридическое лицо, профессиональным участником рынка ценных бумаг, заключившее договор на выполнение функций по обслуживанию операций с облигациями с коммунальным предприятием "Дирекция по работе с ценными бумагами". Дилер может заключать сделки с РКО от своего имени и за свой счет, а также может выполнять функции финансового брокера при заключении сделок от своего имени за счет и по поручению инвестора.
Инвестор - любое юридическое или физическое лицо, заключившее с Дилером договор брокерского обслуживания на рынке РКО. Инвестор может приобретать облигации только через Дилеров, уплачивая при этом комиссию.

Процедура торгов.

В ходе торгов РКО проходят следующие этапы:
* Первичное размещение;
* Вторичные торги;
* Погашение.

Первичное размещение (аукцион).

Аукцион - это первичное размещение облигаций, проводимого Организатором (Коммунальное предприятие "Дирекция по работе с ценными бумагами", агент Министерства финансов РТ по обслуживанию выпусков облигаций) по поручению Министерства финансов Республики Татарстан. Они проводятся по специальному графику. Дата аукциона, предельный объем выпуска, место и время проведения аукциона объявляются Организатором. Контрагентами в этой процедуре являются Министерство Финансов с одной стороны, и Дилеры - другой. В ходе аукциона Дилеры подают заявки на покупку облигаций. После подачи всех заявок до установленного времени, Министерство Финансов устанавливает цену отсечения - минимальная цена, по которой он готов продать облигации. Все заявки, поданные выше цены отсечения, удовлетворяются, заявки, поданные с более низкой ценой, не удовлетворяются.

Вторичные торги.

Обращение облигаций на вторичных торгах осуществляется в форме сделок купли-продажи через Торговую систему (организация, уполномоченная на основании договора с Министерством финансов РТ и двусторонних договоров с Дилерами обеспечивать процедуру заключения сделок купли-продажи путем предоставления технических средств). Контрагентами в этой процедуре выступают Дилеры. Дилеры вводят в Торговую систему посредством рабочих терминалов заявки на покупку или продажу облигаций. Если цены заявок совпадают, то они удовлетворяются, т.е. сделка считается совершенной.

Погашение.

Погашение облигаций производится в определенный день Министерством Финансов по номинальной стоимости.

Документооборот.

РКО обращаются в электронной форме. Учет по ним ведется посредством записей на счетах депо, открытых в Волжско-Камской трастовой компании (ВКТК). В связи с этим возникают вопросы отражения учета операций в документальной форме. В ходе обращения РКО можно выделить следующие типы документов:

* Отчеты, предоставляемые биржей;
* Отчеты, предоставляемые Дилерами.

Отчеты, предоставляемые биржей.

По завершении торгов биржа предоставляет каждому Дилеру следующие документы:
* Биржевая информация;
* Выписка из протокола торгов;
* Обязательства Дилера по итогам торгов;
* Выписка из реестра сделок.

Отчеты, предоставляемые Дилерами.

В процессе участия в торгах Дилеры обязаны предоставлять следующие документы бирже:
* Еженедельный отчет;
* Ежемесячный отчет;
* Другие документы, необходимые для допуска Дилера к торгам.

После совершения сделки купли-продажи по поручению Инвестора, Дилер обязан предоставить Инвестору отчет о совершенной сделке в форме, установленной в договоре по брокерскому обслуживанию и выписку со счета депо. Дилер также может предоставить биржевую информацию и оказывать консультационные услуги.

Глава 2. Задачи Дилера на рынке РКО.

Являясь активным участником рынка РКО, Дилер сталкивается со следующими задачами:
1. Ведение бэк-офиса;
2. Оптимизация вложений собственных средств;
3. Управление средствами Инвесторов;
4. Исполнение поручений Инвесторов;
5. Анализ эффективности вложений.

Ведение бэк-офиса.

Бэк-офис - система электронного учета операций с ценными бумагами. Он включает в себя очень широкий спектр функциональных вопросов:
* Ведение журнала лицевого учета и журнала оборотов (Приложение № 1.3, 1.4);
* Формирование и печать мемориальных ордеров (Приложение №1.5);
* Формирование и печать отчетов Инвесторам (Приложение №1.6);
* Формирование и печать собственного портфеля Дилера (Приложение № 1.7, 1.8);
* Формирование и печать биржевой информации (Приложение №1.9);
* Формирование и печать еженедельного и ежемесячного отчетов (Приложение №1.10, 1.11).
Все перечисленные задачи реализованы в представленной программе автоматизированного учета операций с РКО.

Оптимизация вложений собственных средств.

Под оптимизацией вложений собственных средств понимается создание портфеля облигаций, который удовлетворял бы поставленной инвестиционной или спекулятивной задаче.
Для формирования портфеля можно исходить из следующих факторов:
* Ликвидность;
* "Время жизни";
* Получение наибольшего дохода;
* Использование РКО в залоговых операциях для получения межбанковских кредитов.

Управление средствами инвесторов.

Дилер может сам управлять средствами Инвесторов, если был заключен договор трастового обслуживания. При этом он может брать комиссию как с отдельной сделки, так и с дохода, полученного Инвестором. В данном случае актуальной является задача оптимального управления портфелем Инвестора и оценка эффективности деятельности Дилера.

Исполнение поручений Инвесторов.

Дилер, являясь также и брокером на рынке РКО, совершает операции купли-продажи от своего имени, но по поручению Инвестора и за его счет. В этом случае Дилер должен вести учет приема заявок Инвесторов, исполнение поручений на бирже и формирование отчетов. За эти услуги он получает комиссионное вознаграждение.

Анализ эффективности вложений.

Данная задача является одной из наиболее сложных и необходимых. Определение метода анализа - нетривиальная задача. В Главе 3 рассмотрены две методики анализа эффективности вложений собственных средств в облигации.

Глава 3. Задачи формирования и ведения собственного
портфеля облигаций Дилера.
В процессе управления портфелем облигаций Дилер ставит перед собой следующие задачи:
* формирование портфеля облигаций;
* анализ эффективности вложений денежных средств.

Формирование портфеля облигаций.

В процессе участия в торгах Дилер инвестирует свободные денежные средства в облигации, создавая при этом портфель, состоящий из разных серий РКО, отличающиеся тем, что имеют разные сроки до погашения.
Спецификой портфеля, состоящего из РКО, могут являться следующие моменты:
* ликвидность портфеля;
* период инвестирования;
* инвестирование с целью максимизации дохода;
* безрисковое инвестирование.

Ликвидность портфеля.

При инвестировании средств в РКО необходимо учитывать следующий момент. Денежные средства Дилеров, инвестируемые в облигации на вторичных торгах, часто превышают объемы торгов по какой-либо отдельной серии облигации. В связи с этим возникает вопрос ликвидности портфеля. Как показывает практика фондового рынка, облигации с наименьшим сроком погашения более ликвидные, чем те, которые имеют более длительный срок до погашения. Но, с другой стороны, облигации с меньшим сроком до погашения имеют и меньшую доходность. Таким образом, при продаже легче всего продать облигации с меньшим сроком до погашения, а купить те, которые имеют более длительный срок до погашения.

Период инвестирования.

Дилер при инвестировании сталкивается и со следующей задачей: период инвестирования. Так как ликвидность рынка напрямую зависит от срока до погашения облигации, то с этим приходится диверсифицировать портфеля по срокам погашения облигаций. Причем необходимо выбрать наилучшую стратегию, зависящую от целей инвестирования. Если целью инвестирования является получения максимального дохода за продолжительный период времени, то можно инвестировать средства в наиболее доходные серии облигаций. В случае если целью инвестирования является краткосрочная спекуляция, то наиболее оптимальной стратегией в данном случае является покупка серий облигаций со сроком погашения, близким к установленному сроку инвестирования; в этом случае минимизируется риск невозможности продажи облигаций на вторичном рынке.

Инвестирование с целью максимизации дохода.

В случае если целью инвестирования является максимизация дохода, причем срок инвестирования не фиксирован, т.е. неизвестен период инвестирования, Дилер сталкивается с двумя противоречивыми факторами: доходность и ликвидность. В связи с этим возникают задачи оптимального управления портфелем облигаций. Методы, которые применяют Дилеры, являются их собственными разработками (ноу-хау). Существуют множество публикаций в финансово-экономической литературе по оптимизации вложений в бескупонные облигации, но предложенные методы либо содержат в себе неверные предпосылки при построении метода оптимизации, либо содержат упрощения, после чего модель становится неприменима на практике.

Безрисковое инвестирование.

В целях получения дохода, но также минимизации риска извлечения денежных средств из портфеля, можно формировать портфеля с помощью диверсификации по срокам погашения серий облигаций. Облигации, по определению, являясь долговыми обязательствами, имеют срок погашения, т.е. срок, в который инвестор получает номинал облигации, поэтому о риске вложений приходится говорить лишь с точки зрения периода вложения.

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

Анализ эффективности вложения денежных в РКО можно разделить на анализ внутреннего управления портфелем облигаций и внешнего.
Внутреннее управление - это оценка изменения индекса портфеля в сравнении с индексом рынка.
Внешнее управление - это оценка изменения средневзвешенной доходности к погашению портфеля в сравнении со средневзвешенной доходностью к погашению рынка.
Таким образом, возникает задача сравнения управления портфелем облигаций относительно рынка путем построения некоторого показателя, который адекватно отражал бы динамику изменения портфеля в сравнении с динамикой изменения рынка.

Метод решения.
Предлагаются методики для решения поставленных задач путем построения следующих показателей:

1. Индекс портфеля и рынка (для оценки внутреннего управления).
Индекс строится следующим образом.
Для портфеля:
(1)
(1.1)
(1.2)
где:
значение индекса в момент t
коэффициент
стоимость портфеля по средневзвешенным ценам на момент закрытия торгов в момент t
сумма дополнительных вложений (извлечений) денежных средств в портфель в момент t, причем, если
дополнительные вложения
сумма изъятых денег
средневзвешенная цена i серии на момент закрытия торгов
количество бумаг i серии в портфеле
количество серий бумаг, обращающихся на рынке
Для рынка при расчете коэффициента и переменные будут иметь следующий смысл:
объем капитализации рынка по средневзвешенным ценам на момент t
сумма размещенных (погашенных) средств на аукционе
сумма размещенных средств на аукционе
сумма погашенных средств на аукционе
количество бумаг i серии, обращающихся на рынке

Данный индекс показывает, насколько эффективнее было внутреннее управление портфелем по сравнению с рыночной конъюктурой. Причем, если индекс портфеля меньше индекса рынка, то управление было неэффективным.

2. Эффективная норма доходности к погашению портфеля и рынка (для оценки внешнего управления).
Показатель строится следующим образом(2 метода):
В теории расчета применяется следующий метод:
(2)
где:
(2.1)
сумма i расходного платежа
сумма i доходного платежа
количество дней между i расходным и доходным платежами
эффективная норма доходности, которая и определяется из решения данного уравнения
количество расходных и доходных платежей
Уравнение (2) решается численными методами, причем решение единственно.
Из-за неудобства решения уравнения на практике обычно применяют другой метод нахождения :
(2.2)
где:
доходность к погашению i бумаги
количество i бумаги
дней до погашения i бумаги
рассчитывается следующим образом:
(2.3)
где:
цена покупки i бумаги в % от номинала (расходный платеж)
цена погашения в % от номинала (доходный платеж)
количество дней в году
дней до погашения i бумаги
Данный метод более удобен при расчетах и дает более быстрые результаты, вследствие чего он был применен при построении данного показателя.

Экономическая интерпретация метода.

Анализ с помощью методики построения индекса портфеля и рынка включает в себя следующие моменты:
Индекс построен таким образом, что он адекватно отражает управление портфелем и поведение рынка.
По построенному индексу можно определить доходность к приобретению портфеля и рынка, что бывает необходимым для сравнения вложений в РКО с другими инвестиционными операциями. Доходность к приобретению - это доходность на день расчета, которую можно получить при продаже портфеля облигаций.
Кроме того, можно оценить поведение рынка РКО в сравнении с другими рынками. Методика сравнения может быть различной и их построение требует учета специфики различных рынков.
Второй вид анализа - вычисление эффективной нормы доходности портфеля и рынка.
Предложенный метод отражает поведение рынка и доходность к погашению портфеля в текущий момент времени. Воздействовать на этот показатель можно путем добавления или извлечения денежных средств в портфель облигаций. При этом, эффективное внешнее управление напрямую зависит от объемов добавления/извлечения денежных средств и сложившейся конъюнктурой рынка в день проведения операций, т.е. другими словами, должно быть своевременное проведение данных операций.
Этот вид анализа можно применить также для эффективного распределения свободных ресурсов между различными инвестиционными рынками, оценивая и сравнивая доходности различных рынков и направляя свободные денежные средства на наиболее доходные секторы.

Экономическая интерпретация полученных результатов.

В данной работе сравнивался портфель РКО банка и рынок РКО с февраля по май месяц 1997 года.
При анализе путем построения индекса было выявлено следующее. График, построенный на основе индекса рынка (Приложение №2.3), имеет положительный наклон. Это обусловлено тем, что рынок в то время имел тенденцию к снижению доходности, поэтому, индекс, отражающий доходность к приобретению, увеличивался. В приведенном примере, основанном на реальных данных, внутреннее управление портфелем было эффективным по сравнению с рынком до начала мая месяца.
На графике сравнения доходности портфеля и рынка (Приложение № 2.2) можно видеть падение доходности к погашению портфеля в связи со сложившейся рыночной конъюнктурой. При анализе с помощью данного показателя можно сказать, что апрель месяц был наиболее благоприятным для дополнительного инвестирования денежных средств.

Применение результатов исследования для построения методов эффективного управления портфелем облигаций.

Результаты исследования с помощью применения предложенных методик позволяют сделать основополагающие выводы для построения методов эффективного управления портфелем облигаций. В данном случае, под эффективным управлением понимается получение наибольшего дохода за определенный промежуток времени.
Для построения методик эффективного управления портфелем облигаций необходимо учитывать следующее:
1) управление должно давать максимальный эффект;
2) в управлении нужно учитывать возможность ввода-вывода денежных средств;
3) необходимость попытки прогнозирования ситуации при изменении рыночной конъюнктуры;
4) управление портфелем с точки зрения как доходности, так и ликвидности;
Полученные результаты также позволяют оценить степень влияния человека (в данном случае - трейдер) на управление портфелем облигаций. От методов, применяемых им для принятия решений, зависит эффективность управления портфелем облигаций. В этом случае бывает целесообразным контроль за управлением портфелем со стороны вышестоящего начальства без применения обременительных методик расчетов, с другой стороны, можно поощрять трейдера за успешное управление портфелем облигаций. Следовательно, предложенный индекс можно применить для оценки управления портфелем облигаций трейдером.
Другая задача, которою можно решить на основе полученных результатов - это задача доверительного управления (траст). Основываясь на результатах, можно предложить следующую схему взимания платы за траст со стороны управляющего с клиента. Сравнивается индекс рынка и индекс портфеля облигаций, находящегося в трасте. В случае, если индекс портфеля превосходит индекс рынка, то дополнительный доход, получающийся от более эффективного управления портфелем облигаций, делится в определенной пропорции между управляющим и клиентом. Другой вариант: управляющий гарантирует клиенту определенный процент, а плата управляющему рассчитывается по определенной методике исходя из гарантированного дохода и дохода, полученного свыше.

Заключение.

В работе решены следующие ключевые моменты, необходимые для работы с Республиканскими краткосрочными бескупонными облигациями (РКО):
* Автоматизация учета операций с РКО
* Оценка эффективности вложений в РКО
* Описано функционирование рынка РКО, поставлены задачи, которые решает Дилер на рынке.
Решением задачи автоматизации операций с РКО является программный продукт, написанный на Visual Basic for Microsoft Excel, который позволяет вести полный документооборот Дилера на рынке РКО. Результатами автоматизации являются стандартизованные выходные формы, необходимые для ведения бухгалтерского учета РКО и предоставления различных отчетов.
При решении задачи оценки эффективности вложений в РКО применялись статьи, содержащие информацию об различных методиках расчета доходности облигаций. Результатом решения данной задачи является разработка собственной методики анализа. Методика проверена на реальных численных данных за определенный период функционирования рынка РКО. Конечным продуктом метода является программа, написанная на Visual Basic for Microsoft Excel, позволяющая делать анализ эффективности управления портфелем облигаций. Приведенный метод анализа также можно применить в дальнейшем для построения методов эффективного управления портфелем облигаций.
Обе поставленные задачи внедрены и используются на практике.

Список литературы.

1. Башарин Г.П. «Начала финансовой математики» Москва, «ИНФРА-М» 1997 г.
2. Бродский В., Горлин Ю. «Модель действительной доходности ГКО для клиентов» журнал «Рынок ценных бумаг» №1 1994 г.
3. Ветров А. «Как построить агрегированные показатели доходности рынка ГКО/ОФЗ» журнал «Рынок ценных бумаг» №5 1996 г.
4. Горелов М. «Построение оптимального портфеля ГКО: как максимизировать прибыль» журнал «Рынок ценных бумаг» №6 1996 г.
5. Горелов М., Никифоров Л. «О границах применимости принципа рыночного момента» журнал «Рынок ценных бумаг» №16 1996 г.
6. Горелов М. «Что нельзя упускать при построении модели управления портфелем ГКО» журнал «Рынок ценных бумаг» №11 1996 г.
7. Горлин Ю. «Оценка доходности операций с ГКО: вырианты биржевой игры» журнал «Рынок ценных бумаг» №6 1994 г.
8. Грядовая О. «Доходность как критерий оптимизации решений по управлению портфелем ГКО» журнал «Рынок ценных бумаг» №15 1994 г.
9. Губерниев В. «ГКО в оптимальном портфеле» журнал «Рынок ценных бумаг» №15 1996 г.
10. Демушкина Е. «Сделки с государственными ценными бумагами» журнал «Рынок ценных бумаг» №23 1996 г.
11. Екушов А. «Как превысить среднюю доходность рынка ГКО» журнал «Рынок ценных бумаг» №11 1997 г.
12. Ивахин А. «Как преодолеть ограничения в моделировании рынка ГКО» журнал «Рынок ценных бумаг» №12 1996 г.
13. Комягин В.Б. «Программирование в Excel 5 и Excel 7 на языке Visual Basic» Москва, «Радио и связь» 1996 г.
14. Кузнецов М., Нифатов П. «Денежный поток и торговые операции на рынке ГКО» журнал «Рынок ценных бумаг» №4 1996 г.
15. Мешкова Н. Кулакова Ю. «Прогнозирование тренда цены ГКО» журнал «Рынок ценных бумаг» №6 1996 г.
16. Михеев А. «Играем на заемные средства» журнал «Рынок ценных бумаг» №3 1997 г.
17. Остроушко О., Гришин О. «Доходность и дюрация портфеля ГКО» журнал «Рынок ценных бумаг» №5 1996г.
18. Положение об обслуживании и обращении выпусков РКО РТ(утверждено постановлением Кабинета Министров РТ от 21 апреля 1995 г. № 238)
19. «Потоки платежей,виды облигаций и вычисление доходности» Москва «Консультационное агентство «Соболев» 1996 г.
20. «Рынок ценных бумаг» учебник под ред. Галанова В.А., Басова А.И. Москва «Финансы и статистика» 1996 г.
21. Суменкова Е.В. «Операции с ценными бумагами» Москва «Перспектива» 1997 г.
22. Ушаков П. «О взаимосвязях индикаторов рынка ГКО» журнал «Рынок ценных бумаг» №3 1997 г.
23. Черкасов В.Е. «Практическое руководство по финансово-экономическим расчетам» Москва «Метаинформ» 1995 г.
24. Черновский А. «Как оценить эффективноть управления портфелем ГКО» журнал «Рынок ценных бумаг» №24 1996 г.
25. Четыркин Е. «Методы финансовых и коммерческих расчетов»

Приложения.

Приложение № 1. Программа автоматизации учета РКО.

Приложение 1.1. Руководство пользователя.

Данная программа написана на Microsoft Visual Basic for Excel. Для запуска программы необходимо открыть файл sprav.xls в Excel, после чего в линейке меню появится дополнительный пункт меню «Справочник», состоящий из следующих разделов:
Дата
Просмотр остатков
Печать
Депозитарий
Портфель
Биржевая информация
Отчеты клиентам
Отчет недельный
Отчет месячный
Журнал лицевого учета
Окно
Бумаги
Сделки
Клиенты
Биржа

Рассмотрим подробнее каждое из пунктов меню.
Дата - изменение даты для работы.
Просмотр остатков - просмотр остатков по Клиентам.

Печать - распечатка на принтер следующих данных:
Депозитарий - печать депозитария.
Портфель - печать собственного портфеля Дилера.
Биржевая информация - печать биржевой информации.
Отчеты клиентам - печать отчетов Клиентам.
Отчет недельный - печать еженедельного отчета, предоставляемого в депозитарий.
Отчет месячный - печать ежемесячного отчета, предоставляемого в депозитарий.
Журнал лицевого учета - печать журнала лицевого учета и журнала оборотов Дилера.
Окно - выбор следующих окон для ввода информации:
Бумаги - выбор окна ввода информации об обращающихся на рынке бумагах.
Сделки - выбор окна ввода сделок.
Клиенты - выбор окна ввода Клиентов.
Биржа - выбор окна ввода биржевой информации.

Результатом работы программы являются Приложения №1.3-1.12

Приложение 1.2. Текст программы.

Option Explicit
Option Base 1
Public CurDate As Date
Public DepoArray() As Integer
Public BumArray(); BumArrayV() As Integer
Public Button; Просмотр; ExitVar; Покупка; Продажа; Погашение As Boolean

Const DilerConst = 1000900000
Const FilialConst = 1000999999
Const ConstMaxBum = 100 ' максимальное кол-во бумаг(выпусков)
Const MaxCount = 1000 ' максимальное кол-во сделок по 1-ой бумаге
Const S192 = "50202"
Const S904 = "47423"
Const S960 = "70102"
Const S970 = "70204"
Const SR970 = "70204"
Sub Auto_Open()
ActiveWindow.WindowState = xlMaximized
CurDate = Date
Worksheets("Врем").Cells(1; 4) = CurDate
Application.OnWindow = "CancelChanges"
Application.Windows("Sprav.xls").OnWindow = "Start"
End Sub

Sub Auto_Close()
MenuBars(xlModule).Reset
MenuBars(xlWorksheet).Reset
Application.OnWindow = ""
Application.Windows("Sprav.xls").OnWindow = ""
ActiveWorkbook.Save
End Sub

Sub Start()
Call CreateMenu
Application.DisplayFullScreen = False
ActiveWindow.WindowState = xlMaximized
CurDate = Date
Worksheets("Врем").Cells(1; 4) = CurDate
End Sub

Sub CancelChanges()
MenuBars(xlModule).Reset
MenuBars(xlWorksheet).Reset
End Sub

Sub CreateMenu()
MenuBars(xlModule).Reset
MenuBars(xlWorksheet).Reset
With MenuBars(xlModule).Menus.Add("&Справочник")
.MenuItems.Add "&Дата"; "DateChange"

.MenuItems.Add "П&росмотр остатков"; "PrintOst"

.MenuItems.AddMenu ("&Печать")
.MenuItems("&Печать").MenuItems.Add "&Депозитарий"; "PrintDepo"
.MenuItems("&Печать").MenuItems.Add "&Портфель"; "PrintPortfel"
.MenuItems("&Печать").MenuItems.Add "&Биржевая информация"; "PrintBirgaInfo"
.MenuItems("&Печать").MenuItems.Add "Отчеты &клиентам"; "PrintOtchClient"
.MenuItems("&Печать").MenuItems.Add "Отчет &недельный"; "PrintOtchWeek"
.MenuItems("&Печать").MenuItems.Add "Отчет &месячный"; "PrintOtchMonth"
.MenuItems("&Печать").MenuItems.Add "Журнал &лицевого учета"; "PrintMagazine"

.MenuItems.AddMenu ("&Окно")
.MenuItems("&Окно").MenuItems.Add "&Бумаги"; "ViewPaper"
.MenuItems("&Окно").MenuItems.Add "&Сделки"; "ViewDeal"
.MenuItems("&Окно").MenuItems.Add "&Клиенты"; "ViewClient"
.MenuItems("&Окно").MenuItems.Add "Би&ржа"; "ViewBirga"
.MenuItems("&Окно").MenuItems.Add "&Остатки 812"; "ViewOst812"
.MenuItems("&Окно").MenuItems.Add "О&статки биржа"; "ViewOstBirga"
.MenuItems("&Окно").MenuItems.Add "&Защита"; "ViewProgram"
End With
With MenuBars(xlWorksheet).Menus.Add("&Справочник")
.MenuItems.Add "&Дата"; "DateChange"

.MenuItems.Add "П&росмотр остатков"; "PrintOst"

.MenuItems.AddMenu ("&Печать")
.MenuItems("&Печать").MenuItems.Add "&Депозитарий"; "PrintDepo"
.MenuItems("&Печать").MenuItems.Add "&Портфель"; "PrintPortfel"
.MenuItems("&Печать").MenuItems.Add "&Биржевая информация"; "PrintBirgaInfo"
.MenuItems("&Печать").MenuItems.Add "Отчеты &клиентам"; "PrintOtchClient"
.MenuItems("&Печать").MenuItems.Add "Отчет &недельный"; "PrintOtchWeek"
.MenuItems("&Печать").MenuItems.Add "Отчет &месячный"; "PrintOtchMonth"
.MenuItems("&Печать").MenuItems.Add "Журнал &лицевого учета"; "PrintMagazine"

.MenuItems.AddMenu ("&Окно")
.MenuItems("&Окно").MenuItems.Add "&Бумаги"; "ViewPaper"
.MenuItems("&Окно").MenuItems.Add "&Сделки"; "ViewDeal"
.MenuItems("&Окно").MenuItems.Add "&Клиенты"; "ViewClient"
.MenuItems("&Окно").MenuItems.Add "Би&ржа"; "ViewBirga"
.MenuItems("&Окно").MenuItems.Add "&Остатки 812"; "ViewOst812"
.MenuItems("&Окно").MenuItems.Add "О&статки биржа"; "ViewOstBirga"
.MenuItems("&Окно").MenuItems.Add "&Защита"; "ViewProgram"
End With
End Sub

Sub ViewPaper()
Sheets("Бумаги").Select
Call EndOf
End Sub
Sub ViewDeal()
Sheets("Сделки").Select
Call EndOf
End Sub
Sub ViewClient()
Sheets("Клиенты").Select
Call EndOf
End Sub
Sub ViewBirga()
Sheets("Биржа").Select
Call EndOf
End Sub
Sub ViewOst812()
Sheets("Остатки812").Select
Call EndOf
End Sub
Sub ViewOstBirga()
Sheets("ОстаткиБиржа").Select
Call EndOf
End Sub
Sub ViewProgram()
Sheets("Защита").Select
End Sub

'------------------------------ Печать Депозитария ------------
Sub PrintDepo()
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)
Cells(3; 5) = Worksheets("Врем").Cells(1; 4)
Cells(3; 5).NumberFormat = "Д ММММ, ГГГГ"
Cells(3; 5).HorizontalAlignment = xlCenterAcrossSelection
Cells(3; 5).Font.Bold = True
Num = 9
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 + 1; i + 1).Interior.ColorIndex = 15
Cells(Num + 1; i + 1) = ""
Cells(Num; i + 1).Interior.ColorIndex = 40
Cells(Num; i + 1) = ""
Cells(5; i + 1).Interior.ColorIndex = 40
Next
Cells(Num; 1).Interior.ColorIndex = 40
Cells(Num; 1) = "Итого"
Cells(Num; 1).Font.Bold = True
Cells(Num; 1).Font.Italic = True
Cells(Num; 1).HorizontalAlignment = xlCenter
Cells(Num + 1; 1) = ""
Cells(Num + 1; 1).Interior.ColorIndex = 15
CliNum = Worksheets("Врем").Cells(1; 3)
ReDim DepoArray(CliNum; BumNum)
ReDim DepoFil(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 "Неверный номер клиента в Окне 'Сделки' строка: " + 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)
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) 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)
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) 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) 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 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)
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 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

Скачали данный реферат: Foka, Lachinov, Bogatov, Койначёнок, Юренев, Яковенцев, Jaroslavcev.
Последние просмотренные рефераты на тему: світ рефератів, доклад, м реферат, реферат мировые войны.



1

Поделитесь этой записью или добавьте в закладки