| Скачать .docx |
Курсовая работа: Нахождение критического пути табличным методом
Содержание
2.Метод решения. 4
4.Описание алгоритма. 12
5.Контрольный пример. 15
6.Описание интерфейса с пользователем. 19
Заключение. 20
Литература. 21
Введение
Сетевой график – необходимый элемент сложного производства, состоящего из нескольких связанных и зависящих друг от друга этапов. Выявление критического пути и временных резервов производства – основная задача, решаемая построением сетевого графика. Такие задачи могут быть представлены в виде графа и в виде отображающей его таблицы. Для нахождения критического пути (последовательности этапов работы, определяющих длительность всего проекта и не имеющих резерва по времени) применяются вычислительные методы. Одним из таких методов является табличный метод и применяется для данных, представленных в виде таблицы.
Проблема автоматизации расчёта сетевого графика является достаточно актуальной и важной. Вычисление критического пути с помощью ЭВМ поможет в несколько раз ускорить этот процесс, а при больших графиках – во много раз. Поэтому автоматизация расчёта сетевого графика может иметь большую практическую пользу.
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 |
Целью решения также является:
· Вычисление времени раннего начала работ каждого вида – минимального срока начала работы, считая от начала проекта.
· Вычисление времени раннего завершения работ каждого вида – минимального срока завершения работы, считая от начала проекта.
· Вычисление времени позднего начала работ каждого вида – максимального срока начала работы, считая от начала проекта.
· Вычисление времени позднего завершения работ каждого вида – максимального срока завершения работы, считая от начала проекта.
· Вычисление полного резерва работ каждого вида – максимального запаса времени на которое можно отсрочить начало работы.
Для написания программы был выбран язык VBA по следующим причинам:
1. VisualBasicforApplications позволяет удобно работать с большими таблицами, считывая из них данные, производя над ними преобразования и строя новые.
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 BasicforApplications 2003 /Москва изд. Бином; 2004г. – 880 с.: ил.
Листинг программы
Форма About (справка о программе)
Private Sub UserForm_Terminate()
Hide
InsForm.Show
End Sub
Форма HelpForm 1 (помощь в заполнении таблицы)
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
Форма HelpForm 2 (помощь в понимании результатов вычислений)
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
Форма HelpForm 3 (помощь в переводе единиц времени)
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 (ввод количества этапов работ, проверка формата листа, проверка правильности ввода, вызов справки, выход из программы, переход к расчётной форме)
'Проверка правильности ввода
PrivateSubCommandButton1_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
Форма Perevod 1 (запоминание текущих единиц времени)
'Запоминание текущих единиц времени
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
Форма Perevod 2 (перевод единиц времени, возврат к расчётной форме)
'Переводединицвремени
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