Помощь в написании студенческих работ
Антистрессовый сервис

Нахождение критического пути табличным методом

КурсоваяПомощь в написанииУзнать стоимостьмоей работы

Сетевой график — необходимый элемент сложного производства, состоящего из нескольких связанных и зависящих друг от друга этапов. Выявление критического пути и временных резервов производства — основная задача, решаемая построением сетевого графика. Такие задачи могут быть представлены в виде графа и в виде отображающей его таблицы. Для нахождения критического пути (последовательности этапов… Читать ещё >

Нахождение критического пути табличным методом (реферат, курсовая, диплом, контрольная)

  • Введение 2
  • 1.Постановка задачи 3
  • 2.Метод решения 4
  • 3.Язык программирования 11
  • 4.Описание алгоритма 12
  • 5.Контрольный пример 15
  • 6.Описание интерфейса с пользователем 19
  • Заключение 20
  • Литература 21
  • Листинг программы 22
  • Введение
  • Сетевой график — необходимый элемент сложного производства, состоящего из нескольких связанных и зависящих друг от друга этапов. Выявление критического пути и временных резервов производства — основная задача, решаемая построением сетевого графика. Такие задачи могут быть представлены в виде графа и в виде отображающей его таблицы. Для нахождения критического пути (последовательности этапов работы, определяющих длительность всего проекта и не имеющих резерва по времени) применяются вычислительные методы. Одним из таких методов является табличный метод и применяется для данных, представленных в виде таблицы.
  • Проблема автоматизации расчёта сетевого графика является достаточно актуальной и важной. Вычисление критического пути с помощью ЭВМ поможет в несколько раз ускорить этот процесс, а при больших графиках — во много раз. Поэтому автоматизация расчёта сетевого графика может иметь большую практическую пользу.
  • 1.Постановка задачи
  • Мы рассматриваем задачу, представленную в виде графа.
  • Рис. 1
  • Вершины графа — этапы работ.
  • Рёбра графа — выполнение работы. Рёбра имеют длину, обозначающую продолжительность работы и направление, обозначающее последовательность выполнение работы.
  • Требуется найти такой путь на графе, который бы имел максимальную длину по сравнению со всеми возможными путями для данного графа.
  • Данные задачи также могут быть представлены в виде таблицы
  • Виды работ

    Продолжительность

    1−2

    1−4

    1−5

    2−3

    4−3

    4−6

    4−7

    4−9

    5−6

    6−10

    7−8

    7−9

    • Целью решения также является:
    • · Вычисление времени раннего начала работ каждого вида — минимального срока начала работы, считая от начала проекта.
    • · Вычисление времени раннего завершения работ каждого вида — минимального срока завершения работы, считая от начала проекта.
    • · Вычисление времени позднего начала работ каждого вида — максимального срока начала работы, считая от начала проекта.
    • · Вычисление времени позднего завершения работ каждого вида — максимального срока завершения работы, считая от начала проекта.
    • · Вычисление полного резерва работ каждого вида — максимального запаса времени на которое можно отсрочить начало работы.
    • 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

    1−4

    1−5

    2−3

    4−3

    4−6

    4−7

    4−9

    5−6

    6−10

    7−8

    7−9

    Сначала вводится число этапов работ (в данном примере 10)

    Исходя из данных таблицы заполняется электронная таблица исходных данных, где номер строки — этап начала работы, а номер столбца — этап завершения работы.

    После нажатия на кнопку «ОК» откроется меню решения

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

    Можно осуществить обратный перевод единиц времени.

    Эта задача была решена ранее без использования ЭВМ и имела решение:

    Виды работ

    Продол;

    житель;

    ность

    Время раннего начала

    Время раннего конца

    Время позднего начала

    Время позднего конца

    Полный резерв

    1−2

    1−4

    1−5

    2−3

    4−3

    4−6

    4−7

    4−9

    5−6

    6−10

    7−8

    7−9

    Критический путь: 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 / 10 080

    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 / 525 600

    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 * 10 080

    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 * 525 600

    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 / 10 080

    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 / 525 600

    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 * 10 080

    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 * 525 600

    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

Показать весь текст
Заполнить форму текущей работой