Главное меню Главная Биология и химия Хозяйственное право Цифровые устройства Мировая экономика МЭО Немецкий Неопределено Основы права Этика эстетика Не Российское законодательство Нотариат Общениеэтика семья брак Охрана окружающей среды экология Иностранные языки и языкознание История и исторические личности Коммуникации связь цифровые приборы и радиоэлектроника Краеведение и этнография Кулинария и продукты питания Маркетинг реклама и торговля Счетчики Реклама	Нахождение критического пути табличным методом Нахождение критического пути табличным методом Содержание   Введение. 2 1.Постановка задачи. 3 2.Метод решения. 4 3.Язык программирования. 11 4.Описание алгоритма. 12 5.Контрольный пример. 15 6.Описание интерфейса с пользователем. 19 Заключение. 20 Литература. 21 Листинг программы.. 22 Введение Сетевой график – необходимый элемент сложного производства, состоящего из нескольких связанных и зависящих друг от друга этапов. Выявление критического пути и временных резервов производства – основная задача, решаемая построением сетевого графика. Такие задачи могут быть представлены в виде графа и в виде отображающей его таблицы. Для нахождения критического пути (последовательности этапов работы, определяющих длительность всего проекта и не имеющих резерва по времени) применяются вычислительные методы. Одним из таких методов является табличный метод и применяется для данных, представленных в виде таблицы. Проблема автоматизации расчёта сетевого графика является достаточно актуальной и важной. Вычисление критического пути с помощью ЭВМ поможет в несколько раз ускорить этот процесс, а при больших графиках – во много раз. Поэтому автоматизация расчёта сетевого графика может иметь большую практическую пользу. 1.Постановка задачи Мы рассматриваем задачу, представленную в виде графа. Рис. 1 Вершины графа – этапы работ. Рёбра графа – выполнение работы. Рёбра имеют длину, обозначающую продолжительность работы и направление, обозначающее последовательность выполнение работы. Требуется найти такой путь на графе, который бы имел максимальную длину по сравнению со всеми возможными путями для данного графа. Данные задачи также могут быть представлены в виде таблицы Виды работ Продолжительность 1-2 2 1-4 1 1-5 4 2-3 3 4-3 5 4-6 3 4-7 1 4-9 3 5-6 2 6-10 5 7-8 6 7-9 2 Целью решения также является: ·  Вычисление времени раннего начала работ каждого вида – минимального срока начала работы, считая от начала проекта. ·  Вычисление времени раннего завершения работ каждого вида – минимального срока завершения работы, считая от начала проекта. ·  Вычисление времени позднего начала работ каждого вида – максимального срока начала работы, считая от начала проекта. ·  Вычисление времени позднего завершения работ каждого вида – максимального срока завершения работы, считая от начала проекта. ·  Вычисление полного резерва работ каждого вида – максимального запаса времени на которое можно отсрочить начало работы. 3.Язык программирования   Для написания программы был выбран язык VBA по следующим причинам: 1.                 Visual Basic for Applications позволяет удобно работать с большими таблицами, считывая из них данные, производя над ними преобразования и строя новые. 2.                 Использование VBA под оболочкой Excel позволяет использовать функции данной оболочки, облегчающие ввод данных и работу с ними. 3.                 Этот язык позволяет автоматизировать некоторые этапы написания программы средствами макрорекордера. 4.                 Я хорошо знаком с этим языком и мне удобнее всего будет писать программу именно с помощью VBA. 5.                 Простота в освоении языка и доступность исходных кодов программы позволит последующим пользователям усовершенствовать её, или изменить под свои требования. 4.Описание алгоритма 1.                 При запуске окна ввода начальных данных пользователю предлагается ввести количество этапов работ: А) Выполняется проверка на правильность ввода. Количество выражается числом, оно должно быть целым (если число дробное, то происходит усечение дробной части) и не должно превышать 254. Б) Если условия ввода выполнены, то происходит проверка на наличие информации в листе, о чём выводится сообщение. В) Строится таблица исходных данных 2.                 После прорисовки таблицы пользователь должен заполнить ее значениями:  А) После подтверждения пользователем заполнения таблицы : 3.                 Пользователь переходит к другому рабочему окну, где он имеет возможность активировать расчёт критического пути и сетевого графика, либо перевести единицы времени из одних в другие (например, дни в часы), если в таблице имеются дробные числа, поскольку в конкретной задаче под оболочкой VBA вычисления с использованием дробных чисел дают погрешность. А) Если пользователь выбрал перевод единиц времени, то числа в таблице исходных данных преобразуются по выбранной схеме. Б) Если пользователь выбрал построение сетевого графика, то строится таблица, имеющая данные о времени раннего и позднего начала работы, раннего и позднего завершения работы, а также резерв по времени для каждого этапа и последовательность этапов критического пути. 4.                 Нажав кнопку расчёта сетевого графика, пользователь запускает алгоритм поиска критического пути и сопутствующих данных, который работает следующим образом: 4.1.          В таблицу решения заносится информация из таблицы исходных данных и подсчитывается количество записей (число видов работ). 4.2.          Определяются начальные этапы. Если в таблице исходных данных столбец не содержит данные длительности, значит, этим этапом не завершается ни один вид работ, то есть он начальный. 4.3.          Для всех начальных этапов, найденных по исходной таблице заносятся значения раннего начала работ равные 0 и время раннего окончания работ 0+продолжительность вида работ. 4.4.          Для каждой заполненной таким образом строки определяется этап окончания вида работ и его обозначение запоминается. Из всех видов работ, заканчивающихся на такой этап, выявляется вид, имеющий максимальное значение времени раннего окончания работы. Это значение также запоминается. Далее в таблице отыскиваются виды работ, начинающиеся на ранее запомненный этап и для всех записей, удовлетворяющих условию в графу время раннего начала заносится запомненное максимальное значение времени раннего окончания работы. Алгоритм повторяется, пока не останется ни одной пустой строки. 4.5.          В таблице результатов, где для каждого вида работ определено время раннего начала и завершения, определяется максимальное значение времени раннего окончания работы, которое является длительностью всего проекта. 4.6.          Определяются конечные этапы. Если в таблице исходных данных строка не содержит данные длительности, значит, этим этапом не начинается ни один вид работ, то есть он конечный. 4.7.          Для всех конечных этапов, найденных по исходной таблице заносятся значения позднего завершения работ равные длительности проекта и время позднего  начала работ, равное разнице длительности проекта и длительности вида работ. Вычисляется полный резерв равный разнице между поздним и ранним временем окончания (начала) работ. 4.8.          Для каждой заполненной таким образом строки определяется этап начала вида работ и его обозначение запоминается. Из всех видов работ, начинающихся на такой этап, выявляется вид, имеющий минимальное значение времени позднего начала работы. Это значение также запоминается. Далее в таблице отыскиваются виды работ, заканчивающиеся на ранее запомненный этап и для всех записей, удовлетворяющих условию в графу времени позднего завершения заносится запомненное минимальное значение времени позднего начала работы. Вычисляется полный резерв. Алгоритм повторяется, пока не останется ни одной пустой строки. 4.9.          Выделяются записи, имеющие значение полного резерва равное 0. Такие виды работ входят в критический путь. 4.10.     Для отыскания критического пути из первой встретившейся записи с полным резервом равным нулю берутся значения начала и завершения вида работ. Для всех последующих записей берётся только обозначение этапа завершения вида работ. Работоспособность такому алгоритму обеспечивает структура расчётной таблицы, где виды работ упорядочены по этапам их начала. Однако если пользователь пронумерует этапы в обратном порядке, может случиться так, что какой-нибудь этап встретится в критическом пути два раза, а другой ни разу. Для этого предусмотрен алгоритм поиска повторяющихся значений в критическом пути. Если повторения обнаружены, то программа строит критический путь в обратном порядке. Из последней встретившейся записи с полным резервом равным нулю берутся значения завершения и начала вида работ. Для всех последующих записей берётся только обозначение этапа начала вида работ. 5.                 Результаты вычислений выводятся на экран. Пользователь может перевести единицы времени в обратном порядке (п. 3).   5.Пример решения задачи на ЭВМ Определим критический путь на основе данных о связях между этапами работ и длительности выполнения работ. Пусть задан граф. На основе данных графа строится таблица Виды работ Продол- житель- ность Время раннего начала Время раннего конца Время позднего начала Время позднего конца Полный резерв 1-2 2 1-4 1 1-5 4 2-3 3 4-3 5 4-6 3 4-7 1 4-9 3 5-6 2 6-10 5 7-8 6 7-9 2 Сначала вводится число этапов работ (в данном примере 10) Исходя из данных таблицы заполняется электронная таблица исходных данных, где номер строки – этап начала работы, а номер столбца – этап завершения работы. После нажатия на кнопку «ОК» откроется меню решения В конкретном примере перевод единиц времени не требуется, но для наглядности можно осуществить перевод. Допустим имеются данные о длительности в днях, но есть необходимость представить их в часах. Произведя расчёт получим итоговую таблицу: Можно осуществить обратный перевод единиц времени. Эта задача была решена ранее без использования ЭВМ и имела решение:
Виды работ	Продол- житель- ность	Время раннего начала	Время раннего конца	Время позднего начала	Время позднего конца	Полный резерв
1-2	2	0	2	6	8	6
1-4	1	0	1	1	3	2
1-5	4	0	4	0	4	0
2-3	3	2	5	8	11	6
4-3	5	1	6	6	11	4
4-6	3	1	4	3	6	2
4-7	1	1	2	4	5	3
4-9	3	1	4	8	11	7
5-6	2	4	6	4	6	0
6-10	5	6	11	6	11	0
7-8	6	2	8	5	11	3
7-9	2	2	4	9	11	7

Критический путь: 1-5-6-10

Результаты вычислений вручную и на ЭВМ совпадают.

5.Описание интерфейса и руководство пользователя

При запуске Excel файла появляется стартовое окно, на котором располагаются 2 кнопки:

«Начать работу» при нажатии на эту кнопку вызывается окно ввода начальных данных.

«Выход» при нажатии на эту кнопку происходит закрытие программы и Excel.

В окне ввода начальных данных пользователь задает число этапов работ (число должно быть целым в диапазоне от 3 до 254)

В форме находятся 4 кнопки и флажок

·  «ОК» - формирование таблицы исходных данных и включение режима заполнения таблицы.

·  «Отмена» - закрытие формы

·  «Справка» - вызов справки о программе

·  «Пропустить» - переход к форме решения

·  «Включить подсказки» - включение поясняющих окон.

После заполнения таблицы пользователь переходит к окну решения

На котором располагаются 3 кнопки:

·                   «Определение критического пути» - расчёт критического пути и сопутствующих данных и вывод результатов на экран.

·                   «Возврат к вводу начальных данных» - открытие окна ввода начальных данных и листа ввода.

·                   «Перевод единиц времени» - открытие окна перевода единиц времени в котором нужно выбрать текущие единицы времени и нажать кнопку «ОК», затем выбрать требуемые единицы времени и нажать кнопку «ОК».

Заключение

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

Литература

1.                 Беляев С.П. Курс лекций по «Исследованию операций».

2.                 Кузменко В.Г, Программирование на Microsoft Visual Basic for Applications 2003  /Москва изд. Бином;  2004г. – 880 с.: ил.

Листинг программы

Форма About (справка о программе)

Private Sub UserForm_Terminate()

Hide

InsForm.Show

End Sub

Форма HelpForm1 (помощь в заполнении таблицы)

Private Sub CommandButton1_Click()

Hide

OKForm.StartUpPosition = 0

OKForm.Top = 450

OKForm.Left = 580

OKForm.Show

End Sub

Private Sub CommandButton2_Click()

Hide

InsForm.Show

End Sub

Private Sub UserForm_Terminate()

Hide

InsForm.Show

End Sub

Форма HelpForm2 (помощь в понимании результатов вычислений)

Private Sub CommandButton1_Click()

check = True

Hide

SolForm.StartUpPosition = 0

SolForm.Top = 350

SolForm.Left = 480

SolForm.Show

End Sub

Private Sub CommandButton2_Click()

check = False

Hide

SolForm.StartUpPosition = 0

SolForm.Top = 350

SolForm.Left = 480

SolForm.Show

End Sub

Форма HelpForm3 (помощь в переводе единиц времени)

Private Sub CommandButton1_Click()

check = True

Hide

SolForm.StartUpPosition = 0

SolForm.Top = 350

SolForm.Left = 480

SolForm.Show

End Sub

Private Sub CommandButton2_Click()

check = False

Hide

SolForm.StartUpPosition = 0

SolForm.Top = 350

SolForm.Left = 480

SolForm.Show

End Sub

Форма InsForm (ввод количества этапов работ, проверка формата листа, проверка правильности ввода, вызов справки, выход из программы, переход к расчётной форме)

'Проверка правильности ввода

Private Sub CommandButton1_Click()

Dim Answer As String

Application.ScreenUpdating = False

If iget.Value = "" Then

MsgBox "Введите количество этапов", vbCritical + vbOKOnly, "Ошибка ввода"

Exit Sub

End If

If Not (IsNumeric(iget.Value)) Then

MsgBox "Количество этапов работы должно быть числом", vbCritical + vbOKOnly, "Ошибка ввода"

Exit Sub

End If

If iget.Value < 3 Then

MsgBox "Количество этапов работы должно быть не менее 3", vbCritical + vbOKOnly, "Ошибка ввода"

Exit Sub

End If

If iget.Value > 254 Then

MsgBox "Количество этапов работы должно быть не более 222", vbCritical + vbOKOnly, "Ошибка ввода"

Exit Sub

End If

n = Fix(iget.Value)

'Проверка листа на наличие информации

For i = 1 To 254

For j = 1 To 254

If Not ActiveSheet.Cells(i, j).Value = "" Then

Answer = MsgBox("Лист содержит информацию! При продолжении она будет уничтожена! Продолжить?", vbCritical + vbOKCancel, "Предупреждение")

End If

If Answer = vbCancel Then

i = 254

j = 254

Exit Sub

End If

If Answer = vbOK Then

i = 254

j = 254

End If

Next j

Next i

'Построение таблицы ввода и переход к ней

Range("A1:IV254").Select

Selection.Clear

InsData

Application.ScreenUpdating = True

Hide

If help.Value = True Then

hlp = True

HelpForm1.Show

Else

hlp = False

OKForm.StartUpPosition = 0

OKForm.Top = 450

OKForm.Left = 580

OKForm.Show

End If

End Sub

Private Sub CommandButton2_Click()

Hide

STF.Show

End Sub

Private Sub CommandButton3_Click()

Hide

About.Show

End Sub

Public Sub Start()

iget.Value = n

End Sub

Private Sub CommandButton4_Click()

Dim flag As Boolean

Hide

SolForm.StartUpPosition = 0

SolForm.Top = 350

SolForm.Left = 480

SolForm.Show

flag = True

n = 1

If Not ActiveSheet.Cells(1, 1).Value = "№" Then

MsgBox "Лист не отформатирован для расчёта, воспользуйтесь окном ввода данных", vbCritical + vbOKOnly, "Ошибка"

Hide

InsForm.Show

Exit Sub

End If

Do While flag

n = n + 1

If ActiveSheet.Cells(n, 1).Value = "" Then

flag = False

End If

If ActiveSheet.Cells(n, 1).Value = n - 1 Then

flag = True

Else: flag = False

End If

Loop

n = n - 2

For i = 2 To n

If Not ActiveSheet.Cells(1, i).Value = i - 1 Then

MsgBox "Лист не отформатирован для расчёта, воспользуйтесь окном ввода данных", vbCritical + vbOKOnly, "Ошибка"

Hide

InsForm.Show

Exit Sub

End If

Next i

End Sub

Private Sub SpinButton1_SpinUp()

If iget.Value <= 222 Then

iget.Value = iget.Value + 1

Else

Exit Sub

End If

End Sub

Private Sub SpinButton1_SpinDown()

If iget.Value >= 4 Then

iget.Value = iget.Value - 1

Else

Exit Sub

End If

End Sub

Private Sub UserForm_Initialize()

iget.Value = 10

Sheets("Data").Select

End Sub

Private Sub UserForm_Terminate()

Hide

STF.Show

End Sub

Форма OKForm (подтверждение окончания ввода начальных данных)

Private Sub CommandButton1_Click()

SolForm.StartUpPosition = 0

SolForm.Top = 350

SolForm.Left = 480

Hide

SolForm.Show

End Sub

Private Sub UserForm_Terminate()

Hide

SolForm.StartUpPosition = 0

SolForm.Top = 350

SolForm.Left = 480

SolForm.Show

End Sub

Форма Perevod1 (запоминание текущих единиц времени)

'Запоминание текущих единиц времени

Private Sub CommandButton1_Click()

If Minutes.Value = True Then

edin = 1

End If

If Chas.Value = True Then

edin = 2

End If

If Sutki.Value = True Then

edin = 3

End If

If Nedeli.Value = True Then

edin = 4

End If

If Mes.Value = True Then

edin = 5

End If

If Godi.Value = True Then

edin = 6

End If

Hide

Perevod2.Show

End Sub

Private Sub UserForm_Terminate()

Hide

SolForm.StartUpPosition = 0

SolForm.Top = 350

SolForm.Left = 480

SolForm.Show

End Sub

Форма Perevod2 (перевод единиц времени, возврат к расчётной форме)

'Перевод единиц времени

Private Sub CommandButton1_Click()

Hide

SolForm.Show

If ActiveSheet.Cells(1, 1).Value = "№" Then

If edin = 1 Then

If Minutes.Value = True Then

Exit Sub

End If

If Chas.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 60

End If

Next j

Next i

End If

If Sutki.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 1440

End If

Next j

Next i

End If

If Nedeli.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 10080

End If

Next j

Next i

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 525600

End If

Next j

Next i

End If

End If

If edin = 2 Then

If Minutes.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 60

End If

Next j

Next i

End If

If Chas.Value = True Then

Exit Sub

End If

If Sutki.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 24

End If

Next j

Next i

End If

If Nedeli.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 168

End If

Next j

Next i

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 8760

End If

Next j

Next i

End If

End If

If edin = 3 Then

If Minutes.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 1440

End If

Next j

Next i

End If

If Chas.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 24

End If

Next j

Next i

End If

If Sutki.Value = True Then

Exit Sub

End If

If Nedeli.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 7

End If

Next j

Next i

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 365

End If

Next j

Next i

End If

End If

If edin = 4 Then

If Minutes.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 10080

End If

Next j

Next i

End If

If Chas.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 168

End If

Next j

Next i

End If

If Sutki.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 7

End If

Next j

Next i

End If

If Nedeli.Value = True Then

Exit Sub

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

End If

If edin = 5 Then

If Minutes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Chas.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Sutki.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Nedeli.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Mes.Value = True Then

Exit Sub

End If

If Godi.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 12

End If

Next j

Next i

End If

End If

If edin = 6 Then

If Minutes.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 525600

End If

Next j

Next i

End If

If Chas.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 8760

End If

Next j

Next i

End If

If Sutki.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 365

End If

Next j

Next i

End If

If Nedeli.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Mes.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 12

End If

Next j

Next i

End If

If Godi.Value = True Then

Exit Sub

End If

End If

End If

If ActiveSheet.Cells(1, 1).Value = "Начальный этап" Then

If edin = 1 Then

If Minutes.Value = True Then

Exit Sub

End If

If Chas.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 60

Next j

Next i

End If

If Sutki.Value = True Then

For i = 2 To scount

For j = 3 To 8

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 1440

End If

Next j

Next i

End If

If Nedeli.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 10080

Next j

Next i

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 525600

Next j

Next i

End If

End If

If edin = 2 Then

If Minutes.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 60

Next j

Next i

End If

If Chas.Value = True Then

Exit Sub

End If

If Sutki.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 24

Next j

Next i

End If

If Nedeli.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 168

Next j

Next i

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 8760

Next j

Next i

End If

End If

If edin = 3 Then

If Minutes.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 1440

Next j

Next i

End If

If Chas.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 24

Next j

Next i

End If

If Sutki.Value = True Then

Exit Sub

End If

If Nedeli.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 7

Next j

Next i

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 365

Next j

Next i

End If

End If

If edin = 4 Then

If Minutes.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 10080

Next j

Next i

End If

If Chas.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 168

Next j

Next i

End If

If Sutki.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 7

Next j

Next i

End If

If Nedeli.Value = True Then

Exit Sub

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

End If

If edin = 5 Then

If Minutes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Chas.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Sutki.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Nedeli.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Mes.Value = True Then

Exit Sub

End If

If Godi.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 12

Next j

Next i

End If

End If

If edin = 6 Then

If Minutes.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 525600

Next j

Next i

End If

If Chas.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 8760

Next j

Next i

End If

If Sutki.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 365

Next j

Next i

End If

If Nedeli.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Mes.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 12

Next j

Next i

End If

If Godi.Value = True Then

Exit Sub

End If

End If

End If

End Sub

Private Sub UserForm_Terminate()

Hide

SolForm.StartUpPosition = 0

SolForm.Top = 350

SolForm.Left = 480

SolForm.Show

End Sub

Форма SolForm (проверка правильности заполнения таблицы, проверка формата листа, проверка наличия данных в листе результатов, вызов модуля формирования и заполнения таблицы результатов)

Private Sub CommandButton1_Click()

Dim Ans As String

Dim fl As Boolean

Dim cou As Integer

cou = 0

check = True

If Not ActiveSheet.Cells(1, 1).Value = "№" Then

Ans = MsgBox("Лист не отформатирован для расчёта, воспользуйтесь окном ввода данных", vbCritical + vbOKCancel, "Ошибка")

If Ans = vbOK Then

Hide

InsForm.Show

Sheets("Data").Select

Exit Sub

End If

If Ans = vbCancel Then

Exit Sub

End If

End If

For i = 2 To n + 1

For j = 2 To n + 1

If Not IsNumeric(ActiveSheet.Cells(i, j).Value) Then

MsgBox "Длительность работы должна выражаться числом!", vbCritical + vbOKOnly, "Ошибка"

markcell

Exit Sub

End If

kn = ActiveSheet.Cells(i, j).Value

kk = Fix(ActiveSheet.Cells(i, j).Value)

If kk < kn Then

MsgBox "Дробные числа дают погрешность при вычислении! Воспользуйтесь переводом единиц времени, чтобы получить целые числа.", vbCritical + vbOKOnly, "Ошибка"

markcell

Exit Sub

End If

If Not ActiveSheet.Cells(i, j).Value = "" Then

If Not ActiveSheet.Cells(j, i).Value = "" Then

MsgBox "Есть этапы, которые замыкаются сами на себя! Это приведёт к зацикливанию программы!", vbCritical + vbOKOnly, "Ошибка"

markcell

Exit Sub

End If

End If

Next j

If Not ActiveSheet.Cells(i, i).Value = "" Then

j = i

MsgBox "Точка отсчёта не должна имееть длительности", vbCritical + vbOKOnly, "Ошибка"

markcell

Exit Sub

End If

Next i

For i = 2 To n + 1

fl = False

For j = 2 To n + 1

If Not ActiveSheet.Cells(j, i).Value = "" Then

fl = True

End If

Next j

If fl = True Then

cou = cou + 1

End If

Next i

If cou = n Then

MsgBox "Должен быть хотя бы один начальный этап!", vbCritical + vbOKOnly, "Ошибка"

Exit Sub

End If

If cou = 0 Then

MsgBox "Должен быть хотя бы один конечный этап!", vbCritical + vbOKOnly, "Ошибка"

Exit Sub

End If

If hlp = True Then

Hide

HelpForm2.Show

End If

If check = False Then

Exit Sub

End If

Application.ScreenUpdating = False

Sheets("Rez").Select

If Sheets("Rez").Cells(1, 1).Value = "Начальный этап" Then

Ans = MsgBox("Лист Rez уже содержит результаты вычислений. Сохранить вычисления в другом листе?", vbCritical + vbYesNo, "Информация")

If Ans = vbYes Then

Sheets.Add

For i = 1 To 222

For j = 1 To 8

ActiveSheet.Cells(i, j).Value = Sheets("Rez").Cells(i, j).Value

Next j

Next i

RTable

End If

End If

Sheets("Rez").Select

Range("A1:IV230").Select

Selection.Clear

RTable

Sheets("Data").Select

Solut

Application.ScreenUpdating = True

Sheets("Rez").Select

End Sub

Private Sub CommandButton2_Click()

Hide

InsForm.Start

InsForm.Show

Sheets("Data").Select

End Sub

Private Sub CommandButton6_Click()

check = True

If Not ActiveSheet.Cells(1, 1).Value = "№" Then

If Not ActiveSheet.Cells(1, 1).Value = "Начальный этап" Then

MsgBox "Лист не отформатирован для расчёта, воспользуйтесь окном ввода данных", vbCritical + vbOKOnly, "Ошибка"

Hide

InsForm.Show

Sheets("Data").Select

Exit Sub

End If

End If

If hlp = True Then

Hide

HelpForm3.Show

End If

If check = False Then

Exit Sub

End If

Hide

Perevod1.Show

End Sub

Private Sub UserForm_Terminate()

Hide

STF.Show

End Sub

Форма STF (вход в программу, завершение работы приложения)

Private Sub CommandButton1_Click()

Hide

InsForm.Show

Sheets("Data").Select

End Sub

Private Sub CommandButton2_Click()

Answer = MsgBox("Вы действительно хотите завершить работу?", vbYesNo + vbQuestion + vbDefaultButton2, "Завершение работы")

If Answer = vbYes Then

ThisWorkbook.Saved = True

Application.Quit

End If

End Sub

Private Sub UserForm_Initialize()

STF.Height = Application.Height

STF.Width = Application.Width

'STF.CommandButton1.Left = STF.Width / 4 - 36

'STF.CommandButton1.Top = STF.Top + 15

'STF.CommandButton2.Left = STF.Width / 2 - 10

'STF.CommandButton2.Top = STF.Top + 15

End Sub

Private Sub UserForm_Terminate()

Answer = MsgBox("Вы действительно хотите завершить работу?", vbYesNo + vbQuestion + vbDefaultButton2, "Завершение работы")

If Answer = vbYes Then

ThisWorkbook.Saved = True

Application.Quit

End If

End Sub

Модуль Result (построение таблицы результатов)

Sub RTable()

Range("A1:H1").Select

With Selection.Font

.name = "Arial Cyr"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Range("A1").Select

ActiveCell.FormulaR1C1 = "Начальный этап"

With ActiveCell.Characters(Start:=1, Length:=14).Font

.name = "Arial Cyr"

.FontStyle = "обычный"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Range("B1").Select

Columns("A:A").ColumnWidth = 15

Range("B1").Select

ActiveCell.FormulaR1C1 = "Конечный этап"

With ActiveCell.Characters(Start:=1, Length:=13).Font

.name = "Arial Cyr"

.FontStyle = "обычный"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Range("C1").Select

Columns("B:B").ColumnWidth = 15

ActiveCell.FormulaR1C1 = "Продол- житель- ность"

With ActiveCell.Characters(Start:=1, Length:=20).Font

.name = "Arial Cyr"

.FontStyle = "обычный"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Range("D1").Select

Columns("C:C").ColumnWidth = 12

ActiveCell.FormulaR1C1 = "Время раннего начала"

With ActiveCell.Characters(Start:=1, Length:=20).Font

.name = "Arial Cyr"

.FontStyle = "обычный"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Range("E1").Select

Columns("D:D").ColumnWidth = 12

ActiveCell.FormulaR1C1 = "Время раннего конца"

With ActiveCell.Characters(Start:=1, Length:=19).Font

.name = "Arial Cyr"

.FontStyle = "обычный"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Range("F1").Select

Columns("E:E").ColumnWidth = 12

ActiveCell.FormulaR1C1 = "Время позднего начала"

With ActiveCell.Characters(Start:=1, Length:=21).Font

.name = "Arial Cyr"

.FontStyle = "обычный"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Range("G1").Select

Columns("F:F").ColumnWidth = 12

ActiveCell.FormulaR1C1 = "Время позднего конца"

With ActiveCell.Characters(Start:=1, Length:=20).Font

.name = "Arial Cyr"

.FontStyle = "обычный"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Range("H1").Select

Columns("G:G").ColumnWidth = 12

ActiveCell.FormulaR1C1 = "Полный резерв"

With ActiveCell.Characters(Start:=1, Length:=13).Font

.name = "Arial Cyr"

.FontStyle = "обычный"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Range("I1").Select

Columns("H:H").ColumnWidth = 11

Range("A2").Select

Rows("1:1").RowHeight = 55.5

End Sub

Модуль Solve (построение таблицы начальных данных, нахождение критического пути и сопутствующих данных, выделение ячейки, содержащей неверную информацию)

Public i As Integer

Public j As Integer

Public check As Boolean

Public edin As Integer

Public hlp As Boolean

Public st1 As String

Public st2 As String

Public stroka1 As String

Public stroka2 As String

Public scount As Integer

Public snum As Integer

Public n As Integer

'Модуль построения таблицы

Sub InsData()

st1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

h = n

If h > 26 Then

a = h \ 26

If h Mod 26 = 0 Then

stroka1 = Mid(st1, a - 1, 1)

Else

stroka1 = Mid(st1, a, 1)

End If

b = a * 26

c = h - b

If c = 0 Then c = c + 26

stroka2 = Mid(st1, c, 1)

st2 = stroka1 + stroka2

Else

st2 = Mid(st1, h + 1, 1)

End If

If h = 26 Then

st2 = Mid(st1, 26, 1)

End If

Range("A1:" + Trim(st2) + Trim(Str(n + 1))).Select

With Selection.Font

.name = "Arial Cyr"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Rows("3:3").RowHeight = 18

Range("A1").Select

ActiveCell.FormulaR1C1 = "№"

Range("A2").Select

ActiveCell.FormulaR1C1 = "1"

Range("A3").Select

ActiveCell.FormulaR1C1 = "2"

Range("A2:A3").Select

Selection.AutoFill Destination:=Range("A2:A" + Trim(Str(n + 1))), Type:=xlFillDefault

Range("A2:A" + Trim(Str(n + 1))).Select

Range("B1").Select

ActiveCell.FormulaR1C1 = "1"

Range("C1").Select

ActiveCell.FormulaR1C1 = "2"

Range("B1:C1").Select

Selection.AutoFill Destination:=Range("B1:" + Trim(st2) + "1"), Type:=xlFillDefault

Range("A1:" + Trim(st2) + Trim(Str(n + 1))).Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Range("A1:A" + Trim(Str(n + 1)) + ",A1:" + Trim(st2) + "1").Select

Range("A1").Activate

With Selection.Interior

.ColorIndex = 33

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

End With

Range("A1:" + Trim(st2) + Trim(Str(n + 1))).Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

For i = 1 To n + 1

st1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

h = i

If h > 26 Then

a = h \ 26

If h Mod 26 = 0 Then

stroka1 = Mid(st1, a - 1, 1)

Else

stroka1 = Mid(st1, a, 1)

End If

b = a * 26

c = h - b

If c = 0 Then c = c + 26

stroka2 = Mid(st1, c, 1)

st2 = stroka1 + stroka2

Else

st2 = Mid(st1, h, 1)

End If

If h = 26 Then

st2 = Mid(st1, 26, 1)

End If

Range(Trim(st2) + Trim(Str(i))).Select

With Selection.Interior

.ColorIndex = 33

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

End With

Next i

Range("C2").Select

End Sub

Sub Solut()

Dim fl As Boolean

Dim flag As Boolean

Dim remnach As Integer

Dim remkon As Integer

Dim remdl As Double

Dim maxdl As Double

Dim putt As Boolean

scount = 1

'Ввод в таблицу результатов начальных данных

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

scount = scount + 1

Sheets("Rez").Cells(scount, 1).Value = i - 1

Sheets("Rez").Cells(scount, 2).Value = j - 1

Sheets("Rez").Cells(scount, 3).Value = ActiveSheet.Cells(i, j).Value

End If

Next j

Next i

'Поиск начальных этапов

For i = 2 To n + 1

fl = False

For j = 2 To n + 1

If Not ActiveSheet.Cells(j, i).Value = "" Then

fl = True

End If

Next j

If fl = False Then

For j = 2 To scount

If Sheets("Rez").Cells(j, 1).Value = i - 1 Then

Sheets("Rez").Cells(j, 4).Value = 0

Sheets("Rez").Cells(j, 5).Value = Sheets("Rez").Cells(j, 4).Value + Sheets("Rez").Cells(j, 3).Value

End If

Next j

End If

Next i

'Заполнение раннего начала и конца

flag = True

Do While flag = True

flag = False

For i = 2 To scount

If Not Sheets("Rez").Cells(i, 4).Value = "" Then

remkon = Sheets("Rez").Cells(i, 2)

remdl = Sheets("Rez").Cells(i, 5)

For j = 2 To scount

If Sheets("Rez").Cells(j, 2).Value = remkon Then

If remdl < Sheets("Rez").Cells(j, 5).Value Then

remdl = Sheets("Rez").Cells(j, 5).Value

End If

End If

Next j

For j = 2 To scount

If Sheets("Rez").Cells(j, 1).Value = remkon Then

Sheets("Rez").Cells(j, 4).Value = remdl

Sheets("Rez").Cells(j, 5).Value = Sheets("Rez").Cells(j, 4).Value + Sheets("Rez").Cells(j, 3).Value

End If

Next j

End If

Next i

For i = 2 To scount

If Sheets("Rez").Cells(i, 4).Value = "" Then

flag = True

End If

Next i

Loop

'Определение длительности проекта

maxdl = Sheets("Rez").Cells(2, 5).Value

For i = 2 To scount

If maxdl < Sheets("rez").Cells(i, 5).Value Then

maxdl = Sheets("rez").Cells(i, 5).Value

End If

Next i

'Определение конечных этапов

For i = 2 To n + 1

fl = False

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

fl = True

End If

Next j

If fl = False Then

For j = 2 To scount

If Sheets("Rez").Cells(j, 2).Value = i - 1 Then

Sheets("Rez").Cells(j, 7).Value = maxdl

Sheets("Rez").Cells(j, 6).Value = Sheets("Rez").Cells(j, 7).Value - Sheets("Rez").Cells(j, 3).Value

Sheets("Rez").Cells(j, 8).Value = Sheets("Rez").Cells(j, 7).Value - Sheets("Rez").Cells(j, 5).Value

End If

Next j

End If

Next i

'Заполнение позднего начала и конца

flag = True

Do While flag = True

flag = False

For i = scount To 2 Step -1

If Not Sheets("Rez").Cells(i, 6).Value = "" Then

remnach = Sheets("Rez").Cells(i, 1)

remdl = Sheets("Rez").Cells(i, 6)

For j = scount To 2 Step -1

If Sheets("Rez").Cells(j, 1).Value = remnach Then

If remdl > Sheets("Rez").Cells(j, 6).Value Then

remdl = Sheets("Rez").Cells(j, 6).Value

End If

End If

Next j

For j = scount To 2 Step -1

If Sheets("Rez").Cells(j, 2).Value = remnach Then

Sheets("Rez").Cells(j, 7).Value = remdl

Sheets("Rez").Cells(j, 6).Value = Sheets("Rez").Cells(j, 7).Value - Sheets("Rez").Cells(j, 3).Value

Sheets("Rez").Cells(j, 8).Value = Sheets("Rez").Cells(j, 7).Value - Sheets("Rez").Cells(j, 5).Value

End If

Next j

End If

Next i

For i = 2 To scount

If Sheets("Rez").Cells(i, 6).Value = "" Then

flag = True

End If

Next i

Loop

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

Sheets("Rez").Select

For i = 2 To scount

If Sheets("Rez").Cells(i, 8).Value = 0 Then

Range("A" + Trim(Str(i)) + ":H" + Trim(Str(i))).Select

With Selection.Interior

.ColorIndex = 35

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

End With

End If

Next i

Sheets("Rez").Cells(scount + 2, 1).Value = "Критический путь:"

'Построение критического пути

snum = 1

For i = 2 To scount

If Sheets("Rez").Cells(i, 8).Value = 0 Then

Sheets("Rez").Cells(scount + 2, 2).Value = Sheets("Rez").Cells(i, 1).Value

Sheets("Rez").Cells(scount + 2, 3).Value = Sheets("Rez").Cells(i, 2).Value

snum = 3

remdl = i

i = scount

End If

Next i

For i = remdl To scount

If Sheets("Rez").Cells(i, 8).Value = 0 Then

Sheets("Rez").Cells(scount + 2, snum).Value = Sheets("Rez").Cells(i, 2).Value

snum = snum + 1

End If

Next i

putt = False

For i = 2 To snum - 1

remdl = Sheets("Rez").Cells(scount + 2, i)

For j = i + 1 To snum

If Sheets("Rez").Cells(scount + 2, j).Value = remdl Then

putt = True

End If

Next j

Next i

If putt = True Then

snum = 1

For i = scount To 2 Step -1

If Sheets("Rez").Cells(i, 8).Value = 0 Then

Sheets("Rez").Cells(scount + 2, 2).Value = Sheets("Rez").Cells(i, 1).Value

Sheets("Rez").Cells(scount, 3).Value = Sheets("Rez").Cells(i, 2).Value

snum = 3

remdl = i

i = 2

End If

Next i

For i = remdl To 2 Step -1

If Sheets("Rez").Cells(i, 8).Value = 0 Then

Sheets("Rez").Cells(scount + 2, snum).Value = Sheets("Rez").Cells(i, 2).Value

snum = snum + 1

End If

Next i

End If

Sheets("Rez").Cells(scount + 2, 1).Select

End Sub

Sub markcell()

Dim mst1 As String

Dim mst2 As String

Dim mstroka1 As String

Dim mstroka2 As String

mst1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

h = j

If h > 26 Then

a = h \ 26

If h Mod 26 = 0 Then

mstroka1 = Mid(mst1, a - 1, 1)

Else

mstroka1 = Mid(mst1, a, 1)

End If

b = a * 26

c = h - b

If c = 0 Then c = c + 26

mstroka2 = Mid(mst1, c, 1)

mst2 = mstroka1 + mstroka2

Else

mst2 = Mid(mst1, h, 1)

End If

If h = 26 Then

mst2 = Mid(mst1, 26, 1)

End If

Range(Trim(mst2) + Trim(Str(i))).Select

End Sub