Автоматизация расчета стимулирующих выплат менеджерам по продажам ООО "Полиграфоформление-Флексо"

Уровень положительных и отрицательных аэрофонов в воздухе помещений должен соответствовать «Санитарно-гигиеническим нормам допустимых уровней ионизации воздуха производственных и общественных помещений».

В производственных помещениях уровень шума на рабочих местах не должен превышать значений, установленных «Санитарными нормами допустимых уровней шума на рабочих местах», а уровень вибрации -- «Санитарными нормами вибрации рабочих мест».

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

При размещении рабочих мест с ПЭВМ расстояние между рабочими столами с видеомониторами (в направлении тыла поверхности одного видеомонитора и экрана другого видеомонитора) должно быть не менее 2,0 м, а расстояние между боковыми поверхностями видеомониторов -- не менее 1,2 м. Рабочие места с ПЭВМ при выполнении творческой работы, требующей значительного умственного напряжения или высокой концентрации внимания, рекомендуется изолировать друг от друга перегородками высотой 1,5 -- 2,0 м.

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

Конструкция рабочего стула (кресла) должна обеспечивать поддержание рациональной рабочей позы при работе на ПЭВМ, позволять изменять позу с целью снижения статического напряжения мышц шейно-плечевой области и спины для предупреждения развития утомления. Тип рабочего стула (кресла) следует выбирать с учетом роста пользователя, характера и продолжительности работы с ПЭВМ.

Экран видеомонитора должен находиться от глаз пользователя на расстоянии 600 -- 700 мм, но не ближе 500 мм с учетом размеров алфавитно-цифровых знаков и символов.

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

Для предупреждения преждевременной утомляемости пользователей ПЭВМ рекомендуется организовывать рабочую смену путем чередования работ с использованием ПЭВМ и без него. Продолжительность непрерывной работы с ВДТ без регламентированного перерыва не должна превышать 1 ч. Работа с ПЭВМ в течение более 6 часов за смену (при 8-мичасовой рабочей смене) не допускается.

Во время регламентированных перерывов с целью снижения нервно-эмоционального напряжения, утомления зрительного анализатора, устранения влияния гиподинамии и гипокинезии, предотвращения развития позотонического утомления целесообразно выполнять комплексы упражнений, изложенных в Приложениях 9-11 к СанПиН 2.2.2/2.4.1340-03.

Заключение

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

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

Перечень сокращений, условных обозначений и терминов

Сокращения

ГУ - гибкая упаковка

ДПМиР - департамент продаж, маркетинга и рекламы

ДС - денежные средства

ВДТ - видеодисплейный терминал

ОМиР - отдел маркетинга и рекламы

ОСП - отдел сопровождения продаж

ПЭВМ - персональная электронно-вычислительная машина

СГП - склад готовой продукции

СМ - сырье и материалы

СУПР - система управления потоками работ

ТМЦ - товарно-материальные ценности

УПП - управление продаж продукции

ЭЛТ - электронно-лучевая трубка

Условные обозначения

Вм - стимулирующие выплаты менеджеру по продажам (руб.);

Вк - стимулирующие выплаты координатору (руб.);

Пс - план сдачи готовой продукции заказчика на склад (кг);

Пд - план поступления денежных средств от заказчика (руб.);

Фс - фактически сданная на склад готовая продукция заказчика (кг);

Фд - фактически поступившие от Заказчика денежные средства (руб.);

С - процент выполнения плана по сдаче готовой продукции заказчика (%);

Д - процент выполнения плана поступления денег от заказчика (%);

Б - база для начисления выплат (руб.);

Т - пеня, начисляемая за просрочку платежа от заказчика (% в день);

Дн - количество дней просрочки платежа (дни);

Фм - фиксированная сумма выплаты менеджеру по продажам (руб.)

Фк - фиксированная сумма выплаты координатору (руб.)

Км - премиальный коэффициент менеджера по продажам (%);

Кк - премиальный коэффициент координатора (%);

Термины

Готовая продукция - материальный результат производственного процесса, готовый к отгрузке заказчику в соответствии со Спецификацией, подписанной заказчиком и поставщиком.

Заказчик - компания, являющаяся покупателем продукции предприятия, с которой заключен договор поставки.

Клиент - компания, с которой планируются или ведутся переговоры о возможностях дальнейшего сотрудничества.

Клиентский заказ - заказ, формируемый клиентом (заказчиком) в свободной форме.

Коммерческий заказ - юридически валидный заказ, формируемый управлением продаж продукции на основе одобренных клиентом (заказчиком) коммерческих предложений.

Ожидаемых заказ - формируется в отделе продаж на основе устных или письменных коммуникаций с клиентами (заказчиками).

План продаж - документ, отражающий прогноз суммарного объема продаж готовой продукции в тоннах и деньгах за определенный период, получаемый от всех клиентов (заказчиков) (или по каждому отдельно).

Предварительный График размещения заказов (Портфель заказов) - перечень ожидаемых и клиентских заказов, планируемых к исполнению в следующем месяце, с указанием ориентировочных (желаемых) сроков исполнения.

Производственный заказ - обеспеченный всеми необходимыми составляющими заказ, формируемый на основе коммерческих заказов и поступающий в производство на исполнение.

Список использованных источников

1. Бугорский В. Н., Емельянов А. А., Порховник Ю. М. и др. Под ред. д-ра экон. наук, проф. Михайлушкина А. И. Прикладная информатика в экономике. Учебное пособие- СПб.: СПбГИЭУ, 2009.

2. ГОСТ 19.701-90. Схемы алгоритмов, программ, данных и систем. Условные обозначения и правила выполнения.

3. Дипломное проектирование. Методические указания к дипломному проектированию / Сост. проф. И.А. Брусакова - СПб.: СПбГИЭУ, 2011.

4. Интернет сайт для разработчиков на Visual Basic http://www.vbstreets.ru/

5. Интернет-форум по программированию в VBA http://www.vbaexpress.com/forum/

6. Михеев Р. VBA и программирование в MS Office для пользователей: специальный курс. - СПб.: БХВ-Петербург, 2006.

7. Рындевич И. Статья «Техника безопасности в офисе» http://www.znakcomplect.ru/news/example/index.php?id=470

8. Статья «Правила охраны труда при работе на персональном компьютере» http://www.znakcomplect.ru/news/example/index.php?id=286

Приложение

Приложение 1.1. Декомпозиция процесса жизненного цикла промышленного заказа



Приложение 1.2. Декомпозиция процесса поиска заказов



Приложение 1.3. Декомпозиция процесса планирования исполнения заказа



Приложение 1.4. Декомпозиция процесса исполнения заказа



Приложение 1.5.1. Иерархия процессов жизненного цикла промышленного заказа



Приложение 1.5.2. Иерархия процессов жизненного цикла промышленного заказа

Приложение 2.1. Описание переменных модулей программы

Переменная	Тип данных	Назначение
mMenu	CommandBar	Панель меню
sMenu	CommandBarControl	Кнопки панели меню
Path	String	Путь к папке с файлами
fd	FileDialog	Диалог выбора папки
vrtSI	Variant	Путь к выбранной в диалоге папке
mainBook	Workbook	Главная книга, в которой производится расчет ("Расчет выплат.xls")
pBook	Workbook	Книга с плановыми показателями менеджера по продажам
sBook	Workbook	Книга с фактическими движениями на СГП ("СГП.xls")
mBook	Workbook	Книга с фактическими платежами от заказчика ("Платежи.xls")
plSheet	WorkSheet	Скрытый лист с фактическими платежами от заказчика (таблица 2.3.)
mainSheet	WorkSheet	Лист Главной книги со сводными данными (таблица 2.4. )
manSheet	WorkSheet	Лист Главной книги со списком менеджеров и координаторов (таблица 2.5.)
ktSheet	WorkSheet	Лист Главной книги с критериями расчета (таблицы 2.6., 2.7.)
premSheet	WorkSheet	Лист Главной книги с результатом расчета выплат (таблица 2.8.)
n1	Integer	Количество заполненных строк в таблице
n2	Integer
n31	Integer
n32	Integer
n4	Integer
m	Integer
i	Integer	Счетчики циклов
j	Integer
k	Integer
с	Integer	Номер столбца с премиальным коэффициентом менеджера по продажам
fm	String	Фамилия менеджера по продажам
poisk	Object	Ячейки с найденными данными
poiskM	Object
poiskZ	Object
poiskC	Object
first	String	Адрес первой найденной ячейки
fName	String	Имя файла
manager	String	ФИО менеджера по продажам
zak	String	Наименование заказчика
coord	String	ФИО координатора
status	String	Статус заказчика
kol	Single	Масса готовой продукции
ikol	Single
skol	Single
sum	Single	Платежи от заказчиков
isum	Single
msum	Single
prS	Single	Процент выполнения плана по сдаче готовой продукции на склад
prM	Single	Процент выполнения плана поступления денег от заказчика
pMan	Single	Выплаты менеджеру по продажам
pCoord	Single	Выплаты координатору
ktM	Single	Премиальный коэффициент менеджера по продажам
ktC	Single	Премиальный коэффициент координатора
v	Integer	Номер столбца с премией менеджера за выполнение плана сдачи продукции
base	Single	База для расчета премии за выполнение плана поступления платежей
dp	Integer	Число дней просрочки платежа
pp	Single	Процент за прострочку платежа
sM	Single	Премия менеджера за выполнение плана сдачи готовой продукции
sC	Single	Премия координатора за выполнение плана сдачи готовой продукции
str1	String	Критерии расчета выплат
str2	String
dateS	String	Период фактического поступления готовой продукции на склад
dateM	String	Период фактического поступления платежей
mes	String	Месяц, за который рассчитываются выплаты
Ans	Integer	Значение нажатой в окне сообщения кнопки
spM	String	Список менеджеров, файлы с планами которых не были обнаружены

Приложение 2.2. Листинг модулей программы

Модуль Create_Bar()

Public Sub Create_Bar()

Set mMenu = CommandBars.Add("MyMenu", msoBarTop, , True)

Set sMenu = mMenu.Controls.Add(msoControlButton)

With sMenu

.Style = msoButtonCaption

.Caption = "План"

.OnAction = "Plan"

.TooltipText = "Загрузить плановые показатели"

End With

Set sMenu = mMenu.Controls.Add(msoControlButton)

With sMenu

.Style = msoButtonCaption

.Caption = "Факт"

.OnAction = "Fact"

.TooltipText = "Загрузить фактические показатели"

End With

Set sMenu = mMenu.Controls.Add(msoControlButton)

With sMenu

.Style = msoButtonCaption

.Caption = "Выплаты"

.OnAction = "Calc"

.TooltipText = "Рассчитать выплаты"

End With

mMenu.Visible = True

End Sub

Модуль Plan()

Public Sub Plan()

Check_Folder

If Path = "" Then Exit Sub

Set mainBook = ThisWorkbook

Set mainSheet = mainBook.Sheets(1)

Set manSheet = mainBook.Sheets(2)

With mainSheet

n1 = .UsedRange.Rows.Count

.Range(.Cells(2, 1), .Cells(n1 + 1, 9)).ClearContents

End With

With manSheet

n2 = .Cells(1, 1).CurrentRegion.Rows.Count

ikol = 0

isum = 0

spM = ""

For i = 2 To n2

kol = 0

sum = 0

manager = .Cells(i, 1).Value

fm = Left(manager, InStr(manager, " ") - 1)

If fm = "" Then

MsgBox "Нет данных о ФИО менеджеров. Данные загружены не будут.", vbExclamation

Exit Sub

End If

Set pBook = Nothing

fName = Path & "\" & fm & ".xls"

On Error Resume Next

Application.ScreenUpdating = False

Set pBook = Workbooks.Open(fName, 0, False)

If pBook Is Nothing Then

spM = spM & fm & ", "

Else

With pBook.Sheets(1)

m = .Cells(1, 1).CurrentRegion.Rows.Count

n1 = mainSheet.Cells(1, 1).CurrentRegion.Rows.Count

.Range(.Cells(2, 1), .Cells(m, 4)).Copy mainSheet.Range(mainSheet.Cells(n1 + 1, 2), mainSheet.Cells(n1 + m + 1, 5))

End With

pBook.Close

With mainSheet

For j = n1 + 1 To n1 + m

kol = kol + .Cells(j, 4).Value

sum = sum + .Cells(j, 5).Value

Next

isum = isum + sum

ikol = ikol + kol

.Cells(n1 + 1, 1).Value = manager

.Cells(n1 + m, 2).Value = "Итого:"

.Cells(n1 + m, 4).Value = kol

.Cells(n1 + m, 5).Value = sum

.Range(.Cells(n1 + m, 2), .Cells(n1 + m, 5)).Font.Bold = True

End With

End If

Next

End With

With mainSheet

n1 = .Cells(1, 1).CurrentRegion.Rows.Count + 1

.Cells(n1, 1).Value = "Итого:"

.Cells(n1, 4).Value = ikol

.Cells(n1, 5).Value = isum

.Range(.Cells(n1, 1), .Cells(n1, 5)).Font.Color = RGB(255, 0, 0)

.Range(.Cells(n1, 1), .Cells(n1, 5)).Font.Bold = True

.Range(.Cells(n1, 1), .Cells(n1, 5)).Font.Size = 11

End With

Application.ScreenUpdating = True

If Not spM = "" Then

spM = "Отсутствуют планы менеджеров: " & Left(spM, Len(spM) - 2) & "."

MsgBox spM, vbInformation

End If

On Error GoTo 0

End Sub

Модуль Fact()

Public Sub Fact()

Set mainBook = ThisWorkbook

Set mainSheet = mainBook.Sheets(1)

ikol = 0

skol = 0

isum = 0

msum = 0

With mainSheet

n1 = .Cells(1, 1).CurrentRegion.Rows.Count

If n1 = 1 Then

MsgBox "Сначала нужно загрузить планы менеджеров!", vbExclamation

Exit Sub

End If

Check_Folder

Set sBook = Nothing

Set mBook = Nothing

fName = Path & "\" & "СГП.xls"

Application.ScreenUpdating = False

On Error Resume Next

Set sBook = Workbooks.Open(fName, 0, False)

fName = Path & "\" & "Платежи.xls"

Set mBook = Workbooks.Open(fName, 0, False)

If mBook Is Nothing And sBook Is Nothing Then

MsgBox "В указанной папке файлы СГП.xls и Платежи.xls отсутствуют. Данные загружены не будут.", vbExclamation

Exit Sub

ElseIf mBook Is Nothing Then

Ans = MsgBox("В указанной папке отсутствует файл Платежи.xls. Загрузить данные по СГП?", vbYesNo)

If Ans = vbNo Then sBook.Close (False): Exit Sub

ElseIf sBook Is Nothing Then

Ans = MsgBox("В указанной папке отсутствует файл СГП.xls. Загрузить данные по платежам?", vbYesNo)

If Ans = vbNo Then mBook.Close (False): Exit Sub

End If

.Range(.Cells(2, 6), .Cells(n1 + 1, 9)).ClearContents

Set plSheet = mainBook.Sheets(5)

With plSheet

.UsedRange.Clear

mBook.Sheets(1).UsedRange.Copy .Range("A1")

m = .Cells(1, 1).CurrentRegion.Rows.Count

i = 2

Do

dateM = .Cells(i, 2).Value

If dateM <> "" And IsDate(dateM) = True Then Exit Do

i = i + 1

Loop Until i >= m

plSheet.Visible = xlSheetHidden

End With

With sBook.Sheets(1)

m = .Cells(4, 1).CurrentRegion.Rows.Count

i = 4

Do

dateS = .Cells(i, 6)

If dateS <> "" And IsDate(dateS) = True Then Exit Do

i = i + 1

Loop Until i >= m

End With

If Not (dateM = "" Or dateS = "") Then

dateM = Right(dateM, 7)

dateS = Right(dateS, 7)

If dateM <> dateS Then

MsgBox "Периоды поступления продукции на СГП и платежей не совпадают!", vbInformation

'exit sub

End If

If Not dateM = "" Then Period (dateM) Else Period (dateS)

End If

For i = 2 To n1 - 1

zak = Trim(.Cells(i, 2).Value)

kol = 0

sum = 0

If Not zak = "Итого:" Then

Set poisk = sBook.Sheets(1).Columns(1).Find(What:=zak, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

If Not poisk Is Nothing Then

j = poisk.Row

first = poisk.Address

Do

kol = kol + sBook.Sheets(1).Cells(j, 7)

j = j + 1

Set poisk = sBook.Sheets(1).Columns(1).FindNext(poisk)

If poisk Is Nothing Then Exit Do

Loop Until poisk.Address = first

If Not kol = 0 Then

.Cells(i, 6).Value = kol

.Cells(i, 8) = kol / .Cells(i, 4)

skol = skol + kol

End If

End If

Set poisk = plSheet.Columns(6).Find(zak, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns)

If Not poisk Is Nothing Then

first = poisk.Address

Do

sum = sum + plSheet.Cells(poisk.Row, 3)

Set poisk = plSheet.Columns(6).FindNext(poisk)

If poisk Is Nothing Then Exit Do

Loop Until poisk.Address = first

If Not sum = 0 Then

.Cells(i, 7).Value = sum

.Cells(i, 9) = sum / .Cells(i, 5)

msum = msum + sum

End If

End If

Else

If Not skol = 0 Then

.Cells(i, 6).Value = skol

.Cells(i, 8) = skol / .Cells(i, 4)

End If

If Not msum = 0 Then

.Cells(i, 7).Value = msum

.Cells(i, 9) = msum / .Cells(i, 5)

End If

.Range(.Cells(i, 6), .Cells(i, 9)).Font.Bold = True

ikol = ikol + skol

isum = isum + msum

skol = 0

msum = 0

End If

Next

If Not ikol = 0 Then

.Cells(n1, 6).Value = ikol

.Cells(i, 8) = ikol / .Cells(i, 4)

End If

If Not isum = 0 Then

.Cells(n1, 7).Value = isum

.Cells(i, 9) = isum / .Cells(i, 5)

End If

Range(.Cells(n1, 6), .Cells(n1, 9)).Font.Color = RGB(255, 0, 0)

Range(.Cells(n1, 6), .Cells(n1, 9)).Font.Bold = True

Range(.Cells(n1, 6), .Cells(n1, 9)).Font.Size = 11

sBook.Close SaveChanges:=False

mBook.Close SaveChanges:=False

End With

Application.ScreenUpdating = True

On Error GoTo 0

End Sub

Модуль Check_Folder()

Public Sub Check_Folder()

Set fd = Application.FileDialog(msoFileDialogFolderPicker)

With fd

.ButtonName = "Выбрать"

If .Show = -1 Then

For Each vrtSI In .SelectedItems

Path = CStr(vrtSI)

Next

Else

Path = ""

End If

End With

Set fd = Nothing

End Sub

Модуль Calc()

Public Sub Calc()

Set mainBook = ThisWorkbook

Set mainSheet = mainBook.Sheets(1)

Set manSheet = mainBook.Sheets(2)

Set ktSheet = mainBook.Sheets(3)

Set premSheet = mainBook.Sheets(4)

Set plSheet = mainBook.Sheets(5)

ikol = 0

skol = 0

isum = 0

msum = 0

With mainSheet

n1 = .Cells(1, 1).CurrentRegion.Rows.Count

n2 = manSheet.Cells(1, 1).CurrentRegion.Rows.Count

n31 = ktSheet.Cells(1, 1).CurrentRegion.Rows.Count

n32 = ktSheet.Cells(1, 9).CurrentRegion.Rows.Count

pp = ktSheet.Cells(3, 18).Value

i = 2

Set poisk = .Columns(2).Find("Итого:")

If poisk Is Nothing Or (.Cells(poisk.Row, 6).Value = "" And .Cells(poisk.Row, 7).Value = "") Then

MsgBox "Сначала нужно загрузить план и факт!", vbExclamation

Exit Sub

End If

With premSheet

n4 = 19

.Range("A19:AF38").ClearContents

End With

Do

pMan = 0

pCoord = 0

manager = .Cells(i, 1).Value

Set poiskM = manSheet.Columns(1).Find(manager)

If manSheet.Cells(poiskM.Row, 2).Value = "ведущий" Then v = 5 Else v = 6

coord = manSheet.Cells(poiskM.Row, 3).Value

For j = i To poisk.Row - 1

zak = .Cells(j, 2).Value

status = .Cells(j, 3).Value

Select Case status

Case ""

c = 13

Case "новый"

c = 14

Case "переход"

c = 15

End Select

prM = .Cells(j, 9)

prS = .Cells(j, 8)

ktM = 0

ktC = 0

For k = 3 To n32

With ktSheet

If Not (.Cells(k, 9).Value = "" Or .Cells(k, 10).Value = "") Then

str1 = CStr(prM) & CStr(.Cells(k, 9).Value) & CStr(.Cells(k, 10).Value)

Do Until InStr(str1, ",") = 0

str1 = Left(str1, InStr(str1, ",") - 1) & "." & Right(str1, Len(str1) - InStr(str1, ","))

Loop

Else

str1 = "True"

End If

If Not (.Cells(k, 11).Value = "" Or .Cells(k, 12).Value = "") Then

str2 = CStr(prM) & CStr(.Cells(k, 11).Value) & CStr(.Cells(k, 12).Value)

Do Until InStr(str2, ",") = 0

str2 = Left(str2, InStr(str2, ",") - 1) & "." & Right(str2, Len(str2) - InStr(str2, ","))

Loop

Else

str2 = "True"

End If

If Not (str1 = "True" And str2 = "True") Then

If Evaluate(str1) And Evaluate(str2) Then

ktM = .Cells(k, c).Value

ktC = .Cells(k, 16).Value

Exit For

End If

End If

End With

Next

If Not (ktM = 0 And ktC = 0) Then

base = 0

With plSheet

Set poiskZ = .Columns(6).Find(zak, LookIn:=xlValues, LookAt:=xlPart)

If Not poiskZ Is Nothing Then

first = poiskZ.Address

Do

dp = DateDiff("d", .Cells(poiskZ.Row, 5).Value, .Cells(poiskZ.Row, 2).Value, vbUseSystemDayOfWeek, vbUseSystem) - .Cells(poiskZ.Row, 7).Value

If dp <= 0 Then

base = base + .Cells(poiskZ.Row, 3).Value

ElseIf (pp * dp) < 1 Then

base = base + .Cells(poiskZ.Row, 3).Value * (1 - pp * dp)

End If

Set poiskZ = .Columns(6).FindNext(poiskZ)

Loop Until poiskZ Is Nothing Or poiskZ.Address = first

End If

End With

End If

If ktM = 0 Or ktC = 0 Then

sM = 0

sC = 0

For k = 3 To n31

With ktSheet

If Not (.Cells(k, 1).Value = "" Or .Cells(k, 2).Value = "") Then

str1 = CStr(prS) & CStr(.Cells(k, 1).Value) & CStr(.Cells(k, 2).Value)

Do Until InStr(str1, ",") = 0

str1 = Left(str1, InStr(str1, ",") - 1) & "." & Right(str1, Len(str1) - InStr(str1, ","))

Loop

Else

str1 = "True"

End If

If Not (.Cells(k, 3).Value = "" Or .Cells(k, 4).Value = "") Then

str2 = CStr(prS) & CStr(.Cells(k, 3).Value) & CStr(.Cells(k, 4).Value)

Do Until InStr(str2, ",") = 0

str2 = Left(str2, InStr(str2, ",") - 1) & "." & Right(str2, Len(str2) - InStr(str2, ","))

Loop

Else

str2 = "True"

End If

If Not (str1 = "True" And str2 = "True") Then

If Evaluate(str1) And Evaluate(str2) Then

sM = .Cells(k, v).Value

sC = .Cells(k, 7).Value

Exit For

End If

End If

End With

Next

End If

If ktM = 0 Then pMan = pMan + sM Else pMan = pMan + base * ktM

If ktC = 0 Then pCoord = pCoord + sC Else pCoord = pCoord + base * ktC

Next

With premSheet

.Cells(n4, 1).Value = manager

.Cells(n4, 25).Value = pMan

If v = 5 Then .Cells(n4, 15).Value = "Ведущий менеджер" Else .Cells(n4, 15).Value = "Менеджер"

n4 = n4 + 1

Set poiskC = premSheet.Columns(1).Find(coord)

If poiskC Is Nothing Then

.Cells(n4, 1).Value = coord

.Cells(n4, 25).Value = pCoord

.Cells(n4, 15).Value = "Координатор"

n4 = n4 + 1

Else

.Cells(poiskC.Row, 2).Value = .Cells(poiskC.Row, 2).Value + pCoord

End If

End With

i = poisk.Row + 1

Set poisk = .Columns(2).Find("Итого:", After:=.Cells(poisk.Row, 2))

Loop Until i >= n1 - 1 Or poisk Is Nothing

End With

premSheet.Activate

End Sub

Модуль Period()

Public Sub Period(dateZ As String)

Select Case Left(dateZ, 2)

Case "01"

mes = "январь"

Case "02"

mes = "февраль"

Case "03"

mes = "март"

Case "04"

mes = "апрель"

Case "05"

mes = "май"

Case "06"

mes = "июнь"

Case "07"

mes = "июль"

Case "08"

mes = "август"

Case "09"

mes = "сентябрь"

Case "10"

mes = "октябрь"

Case "11"

mes = "ноябрь"

Case "12"

mes = "декабрь"

End Select

dateZ = mes & " " & Right(dateZ, 4) & "г."

mainBook.Sheets(4).Cells(16, 6).Value = dateZ

End Sub

Размещено на Allbest.ru