Экономико-математическое моделирование : Нахождение критического пути табличным методом
Нахождение критического пути табличным методом
Содержание - Введение 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()HideInsForm.ShowEnd SubФорма HelpForm1 (помощь в заполнении таблицы)Private Sub CommandButton1_Click()HideOKForm.StartUpPosition = 0OKForm.Top = 450OKForm.Left = 580OKForm.ShowEnd SubPrivate Sub CommandButton2_Click()HideInsForm.ShowEnd SubPrivate Sub UserForm_Terminate()HideInsForm.ShowEnd SubФорма HelpForm2 (помощь в понимании результатов вычислений)Private Sub CommandButton1_Click()check = TrueHideSolForm.StartUpPosition = 0SolForm.Top = 350SolForm.Left = 480SolForm.ShowEnd SubPrivate Sub CommandButton2_Click()check = FalseHideSolForm.StartUpPosition = 0SolForm.Top = 350SolForm.Left = 480SolForm.ShowEnd SubФорма HelpForm3 (помощь в переводе единиц времени)Private Sub CommandButton1_Click()check = TrueHideSolForm.StartUpPosition = 0SolForm.Top = 350SolForm.Left = 480SolForm.ShowEnd SubPrivate Sub CommandButton2_Click()check = FalseHideSolForm.StartUpPosition = 0SolForm.Top = 350SolForm.Left = 480SolForm.ShowEnd SubФорма InsForm (ввод количества этапов работ, проверка формата листа, проверка правильности ввода, вызов справки, выход из программы, переход к расчётной форме)'Проверка правильности вводаPrivate Sub CommandButton1_Click()Dim Answer As StringApplication.ScreenUpdating = FalseIf iget.Value = "" ThenMsgBox "Введите количество этапов", vbCritical + vbOKOnly, "Ошибка ввода"Exit SubEnd IfIf Not (IsNumeric(iget.Value)) ThenMsgBox "Количество этапов работы должно быть числом", vbCritical + vbOKOnly, "Ошибка ввода"Exit SubEnd IfIf iget.Value < 3 ThenMsgBox "Количество этапов работы должно быть не менее 3", vbCritical + vbOKOnly, "Ошибка ввода"Exit SubEnd IfIf iget.Value > 254 ThenMsgBox "Количество этапов работы должно быть не более 222", vbCritical + vbOKOnly, "Ошибка ввода"Exit SubEnd Ifn = Fix(iget.Value)'Проверка листа на наличие информацииFor i = 1 To 254For j = 1 To 254If Not ActiveSheet.Cells(i, j).Value = "" ThenAnswer = MsgBox("Лист содержит информацию! При продолжении она будет уничтожена! Продолжить?", vbCritical + vbOKCancel, "Предупреждение")End IfIf Answer = vbCancel Theni = 254j = 254Exit SubEnd IfIf Answer = vbOK Theni = 254j = 254End IfNext jNext i'Построение таблицы ввода и переход к нейRange("A1:IV254").SelectSelection.ClearInsDataApplication.ScreenUpdating = TrueHideIf help.Value = True Thenhlp = TrueHelpForm1.ShowElsehlp = FalseOKForm.StartUpPosition = 0OKForm.Top = 450OKForm.Left = 580OKForm.ShowEnd IfEnd SubPrivate Sub CommandButton2_Click()HideSTF.ShowEnd SubPrivate Sub CommandButton3_Click()HideAbout.ShowEnd SubPublic Sub Start()iget.Value = nEnd SubPrivate Sub CommandButton4_Click()Dim flag As BooleanHideSolForm.StartUpPosition = 0SolForm.Top = 350SolForm.Left = 480SolForm.Showflag = Truen = 1If Not ActiveSheet.Cells(1, 1).Value = "№" ThenMsgBox "Лист не отформатирован для расчёта, воспользуйтесь окном ввода данных", vbCritical + vbOKOnly, "Ошибка"HideInsForm.ShowExit SubEnd IfDo While flagn = n + 1If ActiveSheet.Cells(n, 1).Value = "" Thenflag = FalseEnd IfIf ActiveSheet.Cells(n, 1).Value = n - 1 Thenflag = TrueElse: flag = FalseEnd IfLoopn = n - 2For i = 2 To nIf Not ActiveSheet.Cells(1, i).Value = i - 1 ThenMsgBox "Лист не отформатирован для расчёта, воспользуйтесь окном ввода данных", vbCritical + vbOKOnly, "Ошибка"HideInsForm.ShowExit SubEnd IfNext iEnd SubPrivate Sub SpinButton1_SpinUp()If iget.Value <= 222 Theniget.Value = iget.Value + 1ElseExit SubEnd IfEnd SubPrivate Sub SpinButton1_SpinDown()If iget.Value >= 4 Theniget.Value = iget.Value - 1ElseExit SubEnd IfEnd SubPrivate Sub UserForm_Initialize()iget.Value = 10Sheets("Data").SelectEnd SubPrivate Sub UserForm_Terminate()HideSTF.ShowEnd SubФорма OKForm (подтверждение окончания ввода начальных данных)Private Sub CommandButton1_Click()SolForm.StartUpPosition = 0SolForm.Top = 350SolForm.Left = 480HideSolForm.ShowEnd SubPrivate Sub UserForm_Terminate()HideSolForm.StartUpPosition = 0SolForm.Top = 350SolForm.Left = 480SolForm.ShowEnd SubФорма Perevod1 (запоминание текущих единиц времени)'Запоминание текущих единиц времениPrivate Sub CommandButton1_Click()If Minutes.Value = True Thenedin = 1End IfIf Chas.Value = True Thenedin = 2End IfIf Sutki.Value = True Thenedin = 3End IfIf Nedeli.Value = True Thenedin = 4End IfIf Mes.Value = True Thenedin = 5End IfIf Godi.Value = True Thenedin = 6End IfHidePerevod2.ShowEnd SubPrivate Sub UserForm_Terminate()HideSolForm.StartUpPosition = 0SolForm.Top = 350SolForm.Left = 480SolForm.ShowEnd SubФорма Perevod2 (перевод единиц времени, возврат к расчётной форме)'Перевод единиц времениPrivate Sub CommandButton1_Click()HideSolForm.ShowIf ActiveSheet.Cells(1, 1).Value = "№" ThenIf edin = 1 ThenIf Minutes.Value = True ThenExit SubEnd IfIf Chas.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 60End IfNext jNext iEnd IfIf Sutki.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 1440End IfNext jNext iEnd IfIf Nedeli.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 10080End IfNext jNext iEnd IfIf Mes.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Godi.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 525600End IfNext jNext iEnd IfEnd IfIf edin = 2 ThenIf Minutes.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 60End IfNext jNext iEnd IfIf Chas.Value = True ThenExit SubEnd IfIf Sutki.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 24End IfNext jNext iEnd IfIf Nedeli.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 168End IfNext jNext iEnd IfIf Mes.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Godi.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 8760End IfNext jNext iEnd IfEnd IfIf edin = 3 ThenIf Minutes.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 1440End IfNext jNext iEnd IfIf Chas.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 24End IfNext jNext iEnd IfIf Sutki.Value = True ThenExit SubEnd IfIf Nedeli.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 7End IfNext jNext iEnd IfIf Mes.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Godi.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 365End IfNext jNext iEnd IfEnd IfIf edin = 4 ThenIf Minutes.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 10080End IfNext jNext iEnd IfIf Chas.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 168End IfNext jNext iEnd IfIf Sutki.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 7End IfNext jNext iEnd IfIf Nedeli.Value = True ThenExit SubEnd IfIf Mes.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Godi.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfEnd IfIf edin = 5 ThenIf Minutes.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Chas.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Sutki.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Nedeli.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Mes.Value = True ThenExit SubEnd IfIf Godi.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 12End IfNext jNext iEnd IfEnd IfIf edin = 6 ThenIf Minutes.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 525600End IfNext jNext iEnd IfIf Chas.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 8760End IfNext jNext iEnd IfIf Sutki.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 365End IfNext jNext iEnd IfIf Nedeli.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Mes.Value = True ThenFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 12End IfNext jNext iEnd IfIf Godi.Value = True ThenExit SubEnd IfEnd IfEnd IfIf ActiveSheet.Cells(1, 1).Value = "Начальный этап" ThenIf edin = 1 ThenIf Minutes.Value = True ThenExit SubEnd IfIf Chas.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 60Next jNext iEnd IfIf Sutki.Value = True ThenFor i = 2 To scountFor j = 3 To 8If Not ActiveSheet.Cells(i, j).Value = "" ThenActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 1440End IfNext jNext iEnd IfIf Nedeli.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 10080Next jNext iEnd IfIf Mes.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Godi.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 525600Next jNext iEnd IfEnd IfIf edin = 2 ThenIf Minutes.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 60Next jNext iEnd IfIf Chas.Value = True ThenExit SubEnd IfIf Sutki.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 24Next jNext iEnd IfIf Nedeli.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 168Next jNext iEnd IfIf Mes.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Godi.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 8760Next jNext iEnd IfEnd IfIf edin = 3 ThenIf Minutes.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 1440Next jNext iEnd IfIf Chas.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 24Next jNext iEnd IfIf Sutki.Value = True ThenExit SubEnd IfIf Nedeli.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 7Next jNext iEnd IfIf Mes.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Godi.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 365Next jNext iEnd IfEnd IfIf edin = 4 ThenIf Minutes.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 10080Next jNext iEnd IfIf Chas.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 168Next jNext iEnd IfIf Sutki.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 7Next jNext iEnd IfIf Nedeli.Value = True ThenExit SubEnd IfIf Mes.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Godi.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfEnd IfIf edin = 5 ThenIf Minutes.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Chas.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Sutki.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Nedeli.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Mes.Value = True ThenExit SubEnd IfIf Godi.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 12Next jNext iEnd IfEnd IfIf edin = 6 ThenIf Minutes.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 525600Next jNext iEnd IfIf Chas.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 8760Next jNext iEnd IfIf Sutki.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 365Next jNext iEnd IfIf Nedeli.Value = True ThenMsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"End IfIf Mes.Value = True ThenFor i = 2 To scountFor j = 3 To 8ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 12Next jNext iEnd IfIf Godi.Value = True ThenExit SubEnd IfEnd IfEnd IfEnd SubPrivate Sub UserForm_Terminate()HideSolForm.StartUpPosition = 0SolForm.Top = 350SolForm.Left = 480SolForm.ShowEnd SubФорма SolForm (проверка правильности заполнения таблицы, проверка формата листа, проверка наличия данных в листе результатов, вызов модуля формирования и заполнения таблицы результатов)Private Sub CommandButton1_Click()Dim Ans As StringDim fl As BooleanDim cou As Integercou = 0check = TrueIf Not ActiveSheet.Cells(1, 1).Value = "№" ThenAns = MsgBox("Лист не отформатирован для расчёта, воспользуйтесь окном ввода данных", vbCritical + vbOKCancel, "Ошибка")If Ans = vbOK ThenHideInsForm.ShowSheets("Data").SelectExit SubEnd IfIf Ans = vbCancel ThenExit SubEnd IfEnd IfFor i = 2 To n + 1For j = 2 To n + 1If Not IsNumeric(ActiveSheet.Cells(i, j).Value) ThenMsgBox "Длительность работы должна выражаться числом!", vbCritical + vbOKOnly, "Ошибка"markcellExit SubEnd Ifkn = ActiveSheet.Cells(i, j).Valuekk = Fix(ActiveSheet.Cells(i, j).Value)If kk < kn ThenMsgBox "Дробные числа дают погрешность при вычислении! Воспользуйтесь переводом единиц времени, чтобы получить целые числа.", vbCritical + vbOKOnly, "Ошибка"markcellExit SubEnd IfIf Not ActiveSheet.Cells(i, j).Value = "" ThenIf Not ActiveSheet.Cells(j, i).Value = "" ThenMsgBox "Есть этапы, которые замыкаются сами на себя! Это приведёт к зацикливанию программы!", vbCritical + vbOKOnly, "Ошибка"markcellExit SubEnd IfEnd IfNext jIf Not ActiveSheet.Cells(i, i).Value = "" Thenj = iMsgBox "Точка отсчёта не должна имееть длительности", vbCritical + vbOKOnly, "Ошибка"markcellExit SubEnd IfNext iFor i = 2 To n + 1fl = FalseFor j = 2 To n + 1If Not ActiveSheet.Cells(j, i).Value = "" Thenfl = TrueEnd IfNext jIf fl = True Thencou = cou + 1End IfNext iIf cou = n ThenMsgBox "Должен быть хотя бы один начальный этап!", vbCritical + vbOKOnly, "Ошибка"Exit SubEnd IfIf cou = 0 ThenMsgBox "Должен быть хотя бы один конечный этап!", vbCritical + vbOKOnly, "Ошибка"Exit SubEnd IfIf hlp = True ThenHideHelpForm2.ShowEnd IfIf check = False ThenExit SubEnd IfApplication.ScreenUpdating = FalseSheets("Rez").SelectIf Sheets("Rez").Cells(1, 1).Value = "Начальный этап" ThenAns = MsgBox("Лист Rez уже содержит результаты вычислений. Сохранить вычисления в другом листе?", vbCritical + vbYesNo, "Информация")If Ans = vbYes ThenSheets.AddFor i = 1 To 222For j = 1 To 8ActiveSheet.Cells(i, j).Value = Sheets("Rez").Cells(i, j).ValueNext jNext iRTableEnd IfEnd IfSheets("Rez").SelectRange("A1:IV230").SelectSelection.ClearRTableSheets("Data").SelectSolutApplication.ScreenUpdating = TrueSheets("Rez").SelectEnd SubPrivate Sub CommandButton2_Click()HideInsForm.StartInsForm.ShowSheets("Data").SelectEnd SubPrivate Sub CommandButton6_Click()check = TrueIf Not ActiveSheet.Cells(1, 1).Value = "№" ThenIf Not ActiveSheet.Cells(1, 1).Value = "Начальный этап" ThenMsgBox "Лист не отформатирован для расчёта, воспользуйтесь окном ввода данных", vbCritical + vbOKOnly, "Ошибка"HideInsForm.ShowSheets("Data").SelectExit SubEnd IfEnd IfIf hlp = True ThenHideHelpForm3.ShowEnd IfIf check = False ThenExit SubEnd IfHidePerevod1.ShowEnd SubPrivate Sub UserForm_Terminate()HideSTF.ShowEnd SubФорма STF (вход в программу, завершение работы приложения)Private Sub CommandButton1_Click()HideInsForm.ShowSheets("Data").SelectEnd SubPrivate Sub CommandButton2_Click()Answer = MsgBox("Вы действительно хотите завершить работу?", vbYesNo + vbQuestion + vbDefaultButton2, "Завершение работы")If Answer = vbYes ThenThisWorkbook.Saved = TrueApplication.QuitEnd IfEnd SubPrivate Sub UserForm_Initialize()STF.Height = Application.HeightSTF.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 + 15End SubPrivate Sub UserForm_Terminate()Answer = MsgBox("Вы действительно хотите завершить работу?", vbYesNo + vbQuestion + vbDefaultButton2, "Завершение работы")If Answer = vbYes ThenThisWorkbook.Saved = TrueApplication.QuitEnd IfEnd SubМодуль Result (построение таблицы результатов)Sub RTable()Range("A1:H1").SelectWith Selection.Font.name = "Arial Cyr".Size = 14.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.ColorIndex = xlAutomaticEnd WithWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlBottom.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd WithRange("A1").SelectActiveCell.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 = xlAutomaticEnd WithRange("B1").SelectColumns("A:A").ColumnWidth = 15Range("B1").SelectActiveCell.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 = xlAutomaticEnd WithRange("C1").SelectColumns("B:B").ColumnWidth = 15ActiveCell.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 = xlAutomaticEnd WithRange("D1").SelectColumns("C:C").ColumnWidth = 12ActiveCell.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 = xlAutomaticEnd WithRange("E1").SelectColumns("D:D").ColumnWidth = 12ActiveCell.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 = xlAutomaticEnd WithRange("F1").SelectColumns("E:E").ColumnWidth = 12ActiveCell.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 = xlAutomaticEnd WithRange("G1").SelectColumns("F:F").ColumnWidth = 12ActiveCell.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 = xlAutomaticEnd WithRange("H1").SelectColumns("G:G").ColumnWidth = 12ActiveCell.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 = xlAutomaticEnd WithRange("I1").SelectColumns("H:H").ColumnWidth = 11Range("A2").SelectRows("1:1").RowHeight = 55.5End SubМодуль Solve (построение таблицы начальных данных, нахождение критического пути и сопутствующих данных, выделение ячейки, содержащей неверную информацию)Public i As IntegerPublic j As IntegerPublic check As BooleanPublic edin As IntegerPublic hlp As BooleanPublic st1 As StringPublic st2 As StringPublic stroka1 As StringPublic stroka2 As StringPublic scount As IntegerPublic snum As IntegerPublic n As Integer'Модуль построения таблицыSub InsData()st1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"h = nIf h > 26 Thena = h \ 26If h Mod 26 = 0 Thenstroka1 = Mid(st1, a - 1, 1)Elsestroka1 = Mid(st1, a, 1)End Ifb = a * 26c = h - bIf c = 0 Then c = c + 26stroka2 = Mid(st1, c, 1)st2 = stroka1 + stroka2Elsest2 = Mid(st1, h + 1, 1)End IfIf h = 26 Thenst2 = Mid(st1, 26, 1)End IfRange("A1:" + Trim(st2) + Trim(Str(n + 1))).SelectWith Selection.Font.name = "Arial Cyr".Size = 14.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.ColorIndex = xlAutomaticEnd WithRows("3:3").RowHeight = 18Range("A1").SelectActiveCell.FormulaR1C1 = "№"Range("A2").SelectActiveCell.FormulaR1C1 = "1"Range("A3").SelectActiveCell.FormulaR1C1 = "2"Range("A2:A3").SelectSelection.AutoFill Destination:=Range("A2:A" + Trim(Str(n + 1))), Type:=xlFillDefaultRange("A2:A" + Trim(Str(n + 1))).SelectRange("B1").SelectActiveCell.FormulaR1C1 = "1"Range("C1").SelectActiveCell.FormulaR1C1 = "2"Range("B1:C1").SelectSelection.AutoFill Destination:=Range("B1:" + Trim(st2) + "1"), Type:=xlFillDefaultRange("A1:" + Trim(st2) + Trim(Str(n + 1))).SelectWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlBottom.WrapText = False.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd WithRange("A1:A" + Trim(Str(n + 1)) + ",A1:" + Trim(st2) + "1").SelectRange("A1").ActivateWith Selection.Interior.ColorIndex = 33.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd WithRange("A1:" + Trim(st2) + Trim(Str(n + 1))).SelectSelection.Borders(xlDiagonalDown).LineStyle = xlNoneSelection.Borders(xlDiagonalUp).LineStyle = xlNoneWith Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous.Weight = xlThin.ColorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeTop).LineStyle = xlContinuous.Weight = xlThin.ColorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin.ColorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeRight).LineStyle = xlContinuous.Weight = xlThin.ColorIndex = xlAutomaticEnd WithWith Selection.Borders(xlInsideVertical).LineStyle = xlContinuous.Weight = xlThin.ColorIndex = xlAutomaticEnd WithWith Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous.Weight = xlThin.ColorIndex = xlAutomaticEnd WithFor i = 1 To n + 1st1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"h = iIf h > 26 Thena = h \ 26If h Mod 26 = 0 Thenstroka1 = Mid(st1, a - 1, 1)Elsestroka1 = Mid(st1, a, 1)End Ifb = a * 26c = h - bIf c = 0 Then c = c + 26stroka2 = Mid(st1, c, 1)st2 = stroka1 + stroka2Elsest2 = Mid(st1, h, 1)End IfIf h = 26 Thenst2 = Mid(st1, 26, 1)End IfRange(Trim(st2) + Trim(Str(i))).SelectWith Selection.Interior.ColorIndex = 33.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd WithNext iRange("C2").SelectEnd SubSub Solut()Dim fl As BooleanDim flag As BooleanDim remnach As IntegerDim remkon As IntegerDim remdl As DoubleDim maxdl As DoubleDim putt As Booleanscount = 1'Ввод в таблицу результатов начальных данныхFor i = 2 To n + 1For j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" Thenscount = scount + 1Sheets("Rez").Cells(scount, 1).Value = i - 1Sheets("Rez").Cells(scount, 2).Value = j - 1Sheets("Rez").Cells(scount, 3).Value = ActiveSheet.Cells(i, j).ValueEnd IfNext jNext i'Поиск начальных этаповFor i = 2 To n + 1fl = FalseFor j = 2 To n + 1If Not ActiveSheet.Cells(j, i).Value = "" Thenfl = TrueEnd IfNext jIf fl = False ThenFor j = 2 To scountIf Sheets("Rez").Cells(j, 1).Value = i - 1 ThenSheets("Rez").Cells(j, 4).Value = 0Sheets("Rez").Cells(j, 5).Value = Sheets("Rez").Cells(j, 4).Value + Sheets("Rez").Cells(j, 3).ValueEnd IfNext jEnd IfNext i'Заполнение раннего начала и концаflag = TrueDo While flag = Trueflag = FalseFor i = 2 To scountIf Not Sheets("Rez").Cells(i, 4).Value = "" Thenremkon = Sheets("Rez").Cells(i, 2)remdl = Sheets("Rez").Cells(i, 5)For j = 2 To scountIf Sheets("Rez").Cells(j, 2).Value = remkon ThenIf remdl < Sheets("Rez").Cells(j, 5).Value Thenremdl = Sheets("Rez").Cells(j, 5).ValueEnd IfEnd IfNext jFor j = 2 To scountIf Sheets("Rez").Cells(j, 1).Value = remkon ThenSheets("Rez").Cells(j, 4).Value = remdlSheets("Rez").Cells(j, 5).Value = Sheets("Rez").Cells(j, 4).Value + Sheets("Rez").Cells(j, 3).ValueEnd IfNext jEnd IfNext iFor i = 2 To scountIf Sheets("Rez").Cells(i, 4).Value = "" Thenflag = TrueEnd IfNext iLoop'Определение длительности проектаmaxdl = Sheets("Rez").Cells(2, 5).ValueFor i = 2 To scountIf maxdl < Sheets("rez").Cells(i, 5).Value Thenmaxdl = Sheets("rez").Cells(i, 5).ValueEnd IfNext i'Определение конечных этаповFor i = 2 To n + 1fl = FalseFor j = 2 To n + 1If Not ActiveSheet.Cells(i, j).Value = "" Thenfl = TrueEnd IfNext jIf fl = False ThenFor j = 2 To scountIf Sheets("Rez").Cells(j, 2).Value = i - 1 ThenSheets("Rez").Cells(j, 7).Value = maxdlSheets("Rez").Cells(j, 6).Value = Sheets("Rez").Cells(j, 7).Value - Sheets("Rez").Cells(j, 3).ValueSheets("Rez").Cells(j, 8).Value = Sheets("Rez").Cells(j, 7).Value - Sheets("Rez").Cells(j, 5).ValueEnd IfNext jEnd IfNext i'Заполнение позднего начала и концаflag = TrueDo While flag = Trueflag = FalseFor i = scount To 2 Step -1If Not Sheets("Rez").Cells(i, 6).Value = "" Thenremnach = Sheets("Rez").Cells(i, 1)remdl = Sheets("Rez").Cells(i, 6)For j = scount To 2 Step -1If Sheets("Rez").Cells(j, 1).Value = remnach ThenIf remdl > Sheets("Rez").Cells(j, 6).Value Thenremdl = Sheets("Rez").Cells(j, 6).ValueEnd IfEnd IfNext jFor j = scount To 2 Step -1If Sheets("Rez").Cells(j, 2).Value = remnach ThenSheets("Rez").Cells(j, 7).Value = remdlSheets("Rez").Cells(j, 6).Value = Sheets("Rez").Cells(j, 7).Value - Sheets("Rez").Cells(j, 3).ValueSheets("Rez").Cells(j, 8).Value = Sheets("Rez").Cells(j, 7).Value - Sheets("Rez").Cells(j, 5).ValueEnd IfNext jEnd IfNext iFor i = 2 To scountIf Sheets("Rez").Cells(i, 6).Value = "" Thenflag = TrueEnd IfNext iLoop'Выявление критических этаповSheets("Rez").SelectFor i = 2 To scountIf Sheets("Rez").Cells(i, 8).Value = 0 ThenRange("A" + Trim(Str(i)) + ":H" + Trim(Str(i))).SelectWith Selection.Interior.ColorIndex = 35.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd WithEnd IfNext iSheets("Rez").Cells(scount + 2, 1).Value = "Критический путь:"'Построение критического путиsnum = 1For i = 2 To scountIf Sheets("Rez").Cells(i, 8).Value = 0 ThenSheets("Rez").Cells(scount + 2, 2).Value = Sheets("Rez").Cells(i, 1).ValueSheets("Rez").Cells(scount + 2, 3).Value = Sheets("Rez").Cells(i, 2).Valuesnum = 3remdl = ii = scountEnd IfNext iFor i = remdl To scountIf Sheets("Rez").Cells(i, 8).Value = 0 ThenSheets("Rez").Cells(scount + 2, snum).Value = Sheets("Rez").Cells(i, 2).Valuesnum = snum + 1End IfNext iputt = FalseFor i = 2 To snum - 1remdl = Sheets("Rez").Cells(scount + 2, i)For j = i + 1 To snumIf Sheets("Rez").Cells(scount + 2, j).Value = remdl Thenputt = TrueEnd IfNext jNext iIf putt = True Thensnum = 1For i = scount To 2 Step -1If Sheets("Rez").Cells(i, 8).Value = 0 ThenSheets("Rez").Cells(scount + 2, 2).Value = Sheets("Rez").Cells(i, 1).ValueSheets("Rez").Cells(scount, 3).Value = Sheets("Rez").Cells(i, 2).Valuesnum = 3remdl = ii = 2End IfNext iFor i = remdl To 2 Step -1If Sheets("Rez").Cells(i, 8).Value = 0 ThenSheets("Rez").Cells(scount + 2, snum).Value = Sheets("Rez").Cells(i, 2).Valuesnum = snum + 1End IfNext iEnd IfSheets("Rez").Cells(scount + 2, 1).SelectEnd SubSub markcell()Dim mst1 As StringDim mst2 As StringDim mstroka1 As StringDim mstroka2 As Stringmst1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"h = jIf h > 26 Thena = h \ 26If h Mod 26 = 0 Thenmstroka1 = Mid(mst1, a - 1, 1)Elsemstroka1 = Mid(mst1, a, 1)End Ifb = a * 26c = h - bIf c = 0 Then c = c + 26mstroka2 = Mid(mst1, c, 1)mst2 = mstroka1 + mstroka2Elsemst2 = Mid(mst1, h, 1)End IfIf h = 26 Thenmst2 = Mid(mst1, 26, 1)End IfRange(Trim(mst2) + Trim(Str(i))).SelectEnd Sub
|