• Форма HelpForm 2 (допомога в розумінні результатів обчислень)
  • Форма HelpForm 3 (допомога в перекладі одиниць часу)
  • Форма InsForm (введення кількості етапів робіт, перевірка формату листа, перевірка правильності введення, виклик довідки, вихід з програми, перехід до розрахункової формі)
  • Форма OKForm (підтвердження закінчення введення початкових даних)
  • Форма Perevod 1 (запамятовування поточних одиниць часу)
  • Форма Perevod 2 (переклад одиниць часу, повернення до розрахункової формі)
  • SolForm (перевірка правильності заповнення таблиці, перевірка формату листа, перевірка наявності даних в аркуші результатів, виклик модуля формування та заповнення таблиці результатів)
  • Форма STF (вхід в програму, завершення роботи програми)
  • Модуль Result (побудова таблиці результатів)
  • Модуль Solve (побудова таблиці початкових даних, знаходження критичного шляху і супутніх даних, виділення комірки, що містить неправдиву інформацію)


  • Дата конвертації24.03.2017
    Розмір58.57 Kb.
    Типкурсова робота

    Скачати 58.57 Kb.

    Знаходження критичного шляху табличним методом

    зміст

    Вступ. 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. VisualBasicforApplications дозволяє зручно працювати з великими таблицями, зчитуючи з них дані, виробляючи над ними перетворення і будуючи нові.

    2. Використання VBA під оболонкою Excel дозволяє використовувати функції даної оболонки, що полегшують введення даних і роботу з ними.

    3. Ця мова дозволяє автоматизувати деякі етапи написання програми засобами макрорекордер.

    4. Я добре знайомий з цією мовою і мені зручніше за все буде писати програму саме за допомогою VBA.

    5. Простота в освоєнні мови і доступність вихідних кодів програми дозволить наступним користувачам вдосконалити її, або змінити під свої вимоги.


    4.Опісаніе алгоритму

    1. При запуску вікна введення початкових даних користувачеві пропонується ввести кількість етапів робіт:

    А) Виконується перевірка на правильність введення. Кількість виражається числом, воно повинно бути цілим (якщо число дробове, то відбувається усічення дробової частини) і не повинно перевищувати 254.

    Б) Якщо умови введення виконані, то відбувається перевірка на наявність інформації в листі, про що виводиться повідомлення.

    В) Будується таблиця вихідних даних

    2. Після промальовування таблиці користувач повинен заповнити її значеннями:

    А) після підтвердження користувачем заповнення таблиці:

    3. Користувач переходить до іншого робочого вікна, де він має можливість активувати розрахунок критичного шляху і мережевого графіка, або перевести одиниці часу з одних в інші (наприклад, дні в години), якщо в таблиці є дробові числа, оскільки в конкретному завданні під оболонкою VBA обчислення з використанням дробових чисел дають похибку.

    А) Якщо користувач вибрав переклад одиниць часу, то числа в таблиці вихідних даних перетворюються за обраною схемою.

    Б) Якщо користувач вибрав побудова мережевого графіка, то будується таблиця, що має дані про час раннього і пізнього початку роботи, раннього і пізнього завершення роботи, а також резерв по часу для кожного етапу і послідовність етапів критичного шляху.

    4. Натиснувши кнопку розрахунку мережного графіка, користувач запускає алгоритм пошуку критичного шляху і супутніх даних, який працює в такий спосіб:

    4.1. У таблицю рішення заноситься інформація з таблиці вихідних даних і підраховується кількість записів (число видів робіт).

    4.2. Визначаються початкові етапи. Якщо в таблиці вихідних даних стовпець не містить дані тривалості, значить, цим етапом не закінчується жоден вид робіт, тобто він початковий.

    4.3. Для всіх початкових етапів, знайдених по вихідній таблиці заносяться значення раннього початку робіт рівні 0 і час раннього закінчення робіт 0 + тривалість виду робіт.

    4.4. Для кожної заповненої таким чином рядка визначається етап закінчення виду робіт і його позначення запам'ятовується. З усіх видів робіт, що закінчуються на такий етап, виявляється вид, що має максимальне значення часу раннього закінчення роботи. Це значення також запам'ятовується. Далі в таблиці відшукуються види робіт, що починаються на раніше запомненний етап і для всіх записів, які відповідають умові в графу час раннього початку заноситься запомненное максимальне значення часу раннього закінчення роботи. Алгоритм повторюється, поки не залишиться ні за одну повну висоту.

    4.5. У таблиці результатів, де для кожного виду робіт визначено час раннього початку і завершення, визначається максимальне значення часу раннього закінчення роботи, яке є тривалістю всього проекту.

    4.6. Визначаються кінцеві етапи. Якщо в таблиці вихідних даних рядок не містить дані тривалості, значить, цим етапом не почалась жоден вид робіт, тобто він кінцевий.

    4.7. Для всіх кінцевих етапів, знайдених по вихідній таблиці заносяться значення пізнього завершення робіт рівні тривалості проекту і час пізнього початку робіт, однакову різниці тривалості проекту та тривалості виду робіт. Обчислюється повний резерв дорівнює різниці між пізнім і раннім часом закінчення (початку) робіт.

    4.8. Для кожної заповненої таким чином рядка визначається етап початку виду робіт і його позначення запам'ятовується. З усіх видів робіт, що починаються на такий етап, виявляється вид, що має мінімальне значення часу пізнього початку роботи. Це значення також запам'ятовується. Далі в таблиці відшукуються види робіт, що закінчуються на раніше запомненний етап і для всіх записів, які відповідають умові в графу доби пізнього завершення заноситься запомненное мінімальне значення часу пізнього початку роботи. Обчислюється повний резерв. Алгоритм повторюється, поки не залишиться ні за одну повну висоту.

    4.9. Виділяються записи, що мають значення повного резерву рівне 0. Такі види робіт входять в критичний шлях.

    4.10. Для відшукання критичного шляху з першої зустрілася записи з повним резервом рівним нулю беруться значення початку і завершення виду робіт. Для всіх наступних записів береться тільки позначення етапу завершення виду робіт. Працездатність таким алгоритмом забезпечує структура розрахункової таблиці, де види робіт впорядковані по етапах їх початку. Однак якщо користувач пронумерує етапи в зворотному порядку, може статися так, що який-небудь етап зустрінеться в критичному шляху два рази, а інший ні разу. Для цього передбачений алгоритм пошуку повторюваних значень в критичному шляху. Якщо повторення виявлені, то програма будує критичний шлях у зворотному порядку. З останньої зустрілася записи з повним резервом рівним нулю беруться значення завершення і початку виду робіт. Для всіх наступних записів береться тільки позначення етапу початку виду робіт.

    5. Результати обчислень виводяться на екран. Користувач може перевести одиниці часу в зворотному порядку (п. 3).


    5.Прімер рішення задачі на ЕОМ

    Визначимо критичний шлях на основі даних про зв'язки між етапами робіт і тривалості виконання робіт.

    Нехай заданий граф.

    На основі даних графа будується таблиця

    Види робіт

    Продовжуйте

    жітель-

    ність

    Час раннього початку Час раннього кінця Час пізній початок Час пізнього кінця повний резерв
    1-2 2
    1-4 1
    1-5 4
    2-3 3
    4-3 5
    4-6 3
    4-7 1
    4-9 3
    5-6 2
    6-10 5
    7-8 6
    7-9 2

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

    Виходячи з даних таблиці заповнюється електронна таблиця вихідних даних, де номер рядка - етап початку роботи, а номер стовпчика - етап завершення роботи.

    Після натискання на кнопку «ОК» відкриється меню рішення

    У конкретному прикладі переклад одиниць часу не потрібно, але для наочності можна здійснити переклад. Припустимо є дані про тривалість в днях, але є необхідність представити їх в годиннику.


    Провівши розрахунок отримаємо підсумкову таблицю:

    Можна здійснити зворотний переклад одиниць часу.

    Це завдання було вирішене раніше без використання ЕОМ і мала рішення:

    Види робіт

    Продовжуйте

    жітель-

    ність

    Час раннього початку Час раннього кінця Час пізній початок Час пізнього кінця повний резерв
    1-2 2 0 2 6 8 6
    1-4 1 0 1 1 3 2
    1-5 4 0 4 0 4 0
    2-3 3 2 5 8 11 6
    4-3 5 1 6 6 11 4
    4-6 3 1 4 3 6 2
    4-7 1 1 2 4 5 3
    4-9 3 1 4 8 11 7
    5-6 2 4 6 4 6 0
    6-10 5 6 11 6 11 0
    7-8 6 2 8 5 11 3
    7-9 2 2 4 9 11 7


    Критичний шлях: 1-5-6-10

    Результати обчислень вручну і на ЕОМ збігаються.

    5.Опісаніе інтерфейсу і керівництво користувача

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

    «Почати роботу» при натисканні на цю кнопку викликається вікно введення початкових даних.

    «Вихід» при натисканні на цю кнопку відбувається закриття програми і Excel.

    У вікні введення початкових даних користувач задає число етапів робіт (число повинне бути цілим в діапазоні від 3 до 254)

    У формі знаходяться 4 кнопки і прапорець

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

    · «Скасування» - закриття форми

    · «Довідка» - виклик довідки про програму

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

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

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

    На якому розташовуються 3 кнопки:

    · «Визначення критичного шляху» - розрахунок критичного шляху і супутніх даних і виведення результатів на екран.

    · «Повернення до введення початкових даних» - відкриття вікна введення початкових даних і листа введення.

    · «Переклад одиниць часу» - відкриття вікна перекладу одиниць часу в якому потрібно вибрати поточні одиниці часу і натиснути кнопку «ОК», потім вибрати необхідні одиниці часу і натиснути кнопку «ОК».

    висновок

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


    література

    1. Бєляєв С.П. Курс лекцій з «Дослідженню операцій».

    2. Кузьменко В.Г, Програмування на Microsoft Visual BasicforApplications 2003 / Москва изд. Біном; 2004р. - 880 с .: іл.


    лістинг програми

    Форма About (довідка про програму)

    Private Sub UserForm_Terminate ()

    Hide

    InsForm.Show

    End Sub

    Форма HelpForm 1 (допомога в заповненні таблиці)

    Private Sub CommandButton1_Click ()

    Hide

    OKForm.StartUpPosition = 0

    OKForm.Top = 450

    OKForm.Left = 580

    OKForm.Show

    End Sub

    Private Sub CommandButton2_Click ()

    Hide

    InsForm.Show

    End Sub

    Private Sub UserForm_Terminate ()

    Hide

    InsForm.Show

    End Sub

    Форма HelpForm 2 (допомога в розумінні результатів обчислень)

    Private Sub CommandButton1_Click ()

    check = True

    Hide

    SolForm.StartUpPosition = 0

    SolForm.Top = 350

    SolForm.Left = 480

    SolForm.Show

    End Sub

    Private Sub CommandButton2_Click ()

    check = False

    Hide

    SolForm.StartUpPosition = 0

    SolForm.Top = 350

    SolForm.Left = 480

    SolForm.Show

    End Sub

    Форма HelpForm 3 (допомога в перекладі одиниць часу)

    Private Sub CommandButton1_Click ()

    check = True

    Hide

    SolForm.StartUpPosition = 0

    SolForm.Top = 350

    SolForm.Left = 480

    SolForm.Show

    End Sub

    Private Sub CommandButton2_Click ()

    check = False

    Hide

    SolForm.StartUpPosition = 0

    SolForm.Top = 350

    SolForm.Left = 480

    SolForm.Show

    End Sub

    Форма InsForm (введення кількості етапів робіт, перевірка формату листа, перевірка правильності введення, виклик довідки, вихід з програми, перехід до розрахункової формі)

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

    PrivateSubCommandButton1_Click ()

    Dim Answer As String

    Application.ScreenUpdating = False

    If iget.Value = "" Then

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

    Exit Sub

    End If

    If Not (IsNumeric (iget.Value)) Then

    MsgBox "Кількість етапів роботи повинно бути числом", vbCritical + vbOKOnly, "Помилка введення"

    Exit Sub

    End If

    If iget.Value <3 Then

    MsgBox "Кількість етапів роботи повинно бути не менше 3", vbCritical + vbOKOnly, "Помилка введення"

    Exit Sub

    End If

    If iget.Value> 254 Then

    MsgBox "Кількість етапів роботи повинно бути не більше 222", vbCritical + vbOKOnly, "Помилка введення"

    Exit Sub

    End If

    n = Fix (iget.Value)

    'Перевірка листа на наявність інформації

    For i = 1 To 254

    For j = 1 To 254

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

    Answer = MsgBox ( "Лист містить інформацію! Якщо не перерветься вона буде знищена! Продовжити?", VbCritical + vbOKCancel, "Попередження")

    End If

    If Answer = vbCancel Then

    i = 254

    j = 254

    Exit Sub

    End If

    If Answer = vbOK Then

    i = 254

    j = 254

    End If

    Next j

    Next i

    'Побудова таблиці введення і перехід до неї

    Range ( "A1: IV254"). Select

    Selection.Clear

    InsData

    Application.ScreenUpdating = True

    Hide

    If help.Value = True Then

    hlp = True

    HelpForm1.Show

    Else

    hlp = False

    OKForm.StartUpPosition = 0

    OKForm.Top = 450

    OKForm.Left = 580

    OKForm.Show

    End If

    End Sub

    Private Sub CommandButton2_Click ()

    Hide

    STF.Show

    End Sub

    Private Sub CommandButton3_Click ()

    Hide

    About.Show

    End Sub

    Public Sub Start ()

    iget.Value = n

    End Sub

    Private Sub CommandButton4_Click ()

    Dim flag As Boolean

    Hide

    SolForm.StartUpPosition = 0

    SolForm.Top = 350

    SolForm.Left = 480

    SolForm.Show

    flag = True

    n = 1

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

    MsgBox "Ліст не відформатований для розрахунку, скористайтеся вікном введення даних", vbCritical + vbOKOnly, "Помилка"

    Hide

    InsForm.Show

    Exit Sub

    End If

    Do While flag

    n = n + 1

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

    flag = False

    End If

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

    flag = True

    Else: flag = False

    End If

    Loop

    n = n - 2

    For i = 2 To n

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

    MsgBox "Ліст не відформатований для розрахунку, скористайтеся вікном введення даних", vbCritical + vbOKOnly, "Помилка"

    Hide

    InsForm.Show

    Exit Sub

    End If

    Next i

    End Sub

    Private Sub SpinButton1_SpinUp ()

    If iget.Value <= 222 Then

    iget.Value = iget.Value + 1

    Else

    Exit Sub

    End If

    End Sub

    Private Sub SpinButton1_SpinDown ()

    If iget.Value> = 4 Then

    iget.Value = iget.Value - 1

    Else

    Exit Sub

    End If

    End Sub

    Private Sub UserForm_Initialize ()

    iget.Value = 10

    Sheets ( "Data"). Select

    End Sub

    Private Sub UserForm_Terminate ()

    Hide

    STF.Show

    End Sub

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

    Private Sub CommandButton1_Click ()

    SolForm.StartUpPosition = 0

    SolForm.Top = 350

    SolForm.Left = 480

    Hide

    SolForm.Show

    End Sub

    Private Sub UserForm_Terminate ()

    Hide

    SolForm.StartUpPosition = 0

    SolForm.Top = 350

    SolForm.Left = 480

    SolForm.Show

    End Sub

    Форма Perevod 1 (запам'ятовування поточних одиниць часу)

    'Запам'ятовування поточних одиниць часу

    Private Sub CommandButton1_Click ()

    If Minutes.Value = True Then

    edin = 1

    End If

    If Chas.Value = True Then

    edin = 2

    End If

    If Sutki.Value = True Then

    edin = 3

    End If

    If Nedeli.Value = True Then

    edin = 4

    End If

    If Mes.Value = True Then

    edin = 5

    End If

    If Godi.Value = True Then

    edin = 6

    End If

    Hide

    Perevod2.Show

    End Sub

    Private Sub UserForm_Terminate ()

    Hide

    SolForm.StartUpPosition = 0

    SolForm.Top = 350

    SolForm.Left = 480

    SolForm.Show

    End Sub

    Форма Perevod 2 (переклад одиниць часу, повернення до розрахункової формі)

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

    Private Sub CommandButton1_Click ()

    Hide

    SolForm.Show

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

    If edin = 1 Then

    If Minutes.Value = True Then

    Exit Sub

    End If

    If Chas.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Sutki.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Nedeli.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Mes.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    If Godi.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    End If

    If edin = 2 Then

    If Minutes.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Chas.Value = True Then

    Exit Sub

    End If

    If Sutki.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Nedeli.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Mes.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    If Godi.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    End If

    If edin = 3 Then

    If Minutes.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Chas.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Sutki.Value = True Then

    Exit Sub

    End If

    If Nedeli.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Mes.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    If Godi.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    End If

    If edin = 4 Then

    If Minutes.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Chas.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Sutki.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Nedeli.Value = True Then

    Exit Sub

    End If

    If Mes.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    If Godi.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    End If

    If edin = 5 Then

    If Minutes.Value = True Then

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

    End If

    If Chas.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    If Sutki.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    If Nedeli.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    If Mes.Value = True Then

    Exit Sub

    End If

    If Godi.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    End If

    If edin = 6 Then

    If Minutes.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Chas.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Sutki.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Nedeli.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    If Mes.Value = True Then

    For i = 2 To n + 1

    For j = 2 To n + 1

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

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

    End If

    Next j

    Next i

    End If

    If Godi.Value = True Then

    Exit Sub

    End If

    End If

    End If

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

    If edin = 1 Then

    If Minutes.Value = True Then

    Exit Sub

    End If

    If Chas.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Sutki.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

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

    End If

    Next j

    Next i

    End If

    If Nedeli.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Mes.Value = True Then

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

    End If

    If Godi.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    End If

    If edin = 2 Then

    If Minutes.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Chas.Value = True Then

    Exit Sub

    End If

    If Sutki.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Nedeli.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Mes.Value = True Then

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

    End If

    If Godi.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    End If

    If edin = 3 Then

    If Minutes.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Chas.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Sutki.Value = True Then

    Exit Sub

    End If

    If Nedeli.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Mes.Value = True Then

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

    End If

    If Godi.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    End If

    If edin = 4 Then

    If Minutes.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Chas.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Sutki.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Nedeli.Value = True Then

    Exit Sub

    End If

    If Mes.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    If Godi.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    End If

    If edin = 5 Then

    If Minutes.Value = True Then

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

    End If

    If Chas.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    If Sutki.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    If Nedeli.Value = True Then

    MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка введення"

    End If

    If Mes.Value = True Then

    Exit Sub

    End If

    If Godi.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    End If

    If edin = 6 Then

    If Minutes.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Chas.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Sutki.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Nedeli.Value = True Then

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

    End If

    If Mes.Value = True Then

    For i = 2 To scount

    For j = 3 To 8

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

    Next j

    Next i

    End If

    If Godi.Value = True Then

    Exit Sub

    End If

    End If

    End If

    End Sub

    Private Sub UserForm_Terminate ()

    Hide

    SolForm.StartUpPosition = 0

    SolForm.Top = 350

    SolForm.Left = 480

    SolForm.Show

    End Sub

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

    Private Sub CommandButton1_Click ()

    Dim Ans As String

    Dim fl As Boolean

    Dim cou As Integer

    cou = 0

    check = True

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

    Ans = MsgBox ( "Лист не відформатовано для розрахунку, скористайтеся вікном введення даних", vbCritical + vbOKCancel, "Помилка")

    If Ans = vbOK Then

    Hide

    InsForm.Show

    Sheets ( "Data"). Select

    Exit Sub

    End If

    If Ans = vbCancel Then

    Exit Sub

    End If

    End If

    For i = 2 To n + 1

    For j = 2 To n + 1

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

    MsgBox "Тривалість роботи повинна виражатися числом!", VbCritical + vbOKOnly, "Помилка"

    markcell

    Exit Sub

    End If

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

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

    If kk

    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

    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

    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