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

[ виправити ] текст може містити помилки, будь ласка перевіряйте перш ніж використовувати.

скачати

Зміст
Введення. 2
1.Постановка завдання. 3
2.Метод рішення. 4
3.Язик програмування. 11
4.Опісаніе алгоритму. 12
5.Контрольний приклад. 15
6.Опісаніе інтерфейсу з користувачем. 19
Висновок. 20
Література. 21
Лістинг програми .. 22

Введення
Мережевий графік - необхідний елемент складного виробництва, що складається з декількох пов'язаних і незалежних один від одного етапів. Виявлення критичного шляху і тимчасових резервів виробництва - основне завдання, яке вирішується побудовою мережевого графіка. Такі завдання можуть бути представлені у вигляді графа та у вигляді відображає його таблиці. Для знаходження критичного шляху (послідовності етапів роботи, що визначають тривалість всього проекту і не мають резерву за часом) застосовуються обчислювальні методи. Одним з таких методів є табличний метод і застосовується для даних, представлених у вигляді таблиці.
Проблема автоматизації розрахунку мережного графіка є досить актуальною і важливою. Обчислення критичного шляху за допомогою ЕОМ допоможе в кілька разів прискорити цей процес, а при великих графіках - у багато разів. Тому автоматизація розрахунку мережного графіка може мати велику практичну користь.

1.Постановка завдання
Ми розглядаємо завдання, представлену у вигляді графа.
SHAPE \ * MERGEFORMAT
2
1
4
3
6
8
5
7
10
9
2
3
1
3
6
5
5
1
4
2
3
2
Рис. 1
Вершини графа - етапи робіт.
Ребра графа - виконання роботи. Ребра мають довжину, що позначає тривалість роботи і напрям, що означає послідовність виконання роботи.
Потрібно знайти такий шлях на графі, який би мав максимальну довжину в порівнянні з усіма можливими шляхами для даного графа.
Дані завдання також можуть бути представлені у вигляді таблиці
Види робіт
Тривалість
1-2
2
1-4
1
1-5
4
2-3
3
4-3
5
4-6
3
4-7
1
4-9
3
5-6
2
6-10
5
7-8
6
7-9
2
Метою рішення також є:
· Обчислення часу раннього початку робіт кожного виду - мінімального терміну початку роботи, рахуючи від початку проекту.
· Обчислення часу раннього завершення робіт кожного виду - мінімального терміну завершення роботи, рахуючи від початку проекту.
· Обчислення часу пізнього початку робіт кожного виду - максимального терміну початку роботи, рахуючи від початку проекту.
· Обчислення часу пізнього завершення робіт кожного виду - максимального терміну завершення роботи, рахуючи від початку проекту.
· Обчислення повного резерву робіт кожного виду - максимального запасу часу на яке можна відстрочити початок роботи.
3.Язик програмування
Для написання програми була обрана мова VBA з наступних причин:
1. Visual Basic for Applications дозволяє зручно працювати з великими таблицями, зчитуючи з них дані, виробляючи над ними перетворення і будуючи нові.
2. Використання VBA під оболонкою Excel дозволяє використовувати функції даної оболонки, що полегшують введення даних і роботу з ними.
3. Ця мова дозволяє автоматизувати деякі етапи написання програми засобами макрорекордер.
4. Я добре знайомий з цією мовою і мені зручніше за все буде писати програму саме за допомогою VBA.
5. Простота в освоєнні мови і доступність вихідних кодів програми дозволить наступним користувачам удосконалити її, або змінити під свої вимоги.

4.Опісаніе алгоритму
1. При запуску вікна введення початкових даних користувачеві пропонується ввести кількість етапів робіт:
А) Виконується перевірка на правильність введення. Кількість виражається числом, воно має бути цілим (якщо число дробове, то відбувається усікання дробової частини) і не повинна перевищувати 254.
Б) Якщо умови введення виконані, то відбувається перевірка на наявність інформації у листі, про що виводиться повідомлення.
В) Будується таблиця вихідних даних
2. Після промальовування таблиці користувач повинен заповнити її значеннями:
А) Після підтвердження користувачем заповнення таблиці:
3. Користувач переходить до іншого робочого вікна, де він має можливість активувати розрахунок критичного шляху і мережевого графіка, або перевести одиниці часу з одних в інші (наприклад, дні у години), якщо в таблиці є дробові числа, оскільки в конкретній задачі під оболонкою VBA обчислення з використанням дробових чисел дає похибку.
А) Якщо користувач вибрав переклад одиниць часу, то числа в таблиці вихідних даних перетворюються за обраною схемою.
Б) Якщо користувач вибрав побудову мережевого графіка, то будується таблиця, що має дані про час раннього і пізнього початку роботи, раннього і пізнього завершення роботи, а також резерв за часом для кожного етапу і послідовність етапів критичного шляху.
4. Натиснувши кнопку розрахунку мережного графіка, користувач запускає алгоритм пошуку критичного шляху і супутніх даних, який працює таким чином:
4.1. У таблицю рішення заноситься інформація з таблиці вихідних даних і підраховується кількість записів (число видів робіт).
4.2. Визначаються початкові етапи. Якщо в таблиці вихідних даних стовпець не містить дані тривалості, значить, цим етапом не завершується жоден вид робіт, тобто він початковий.
4.3. Для всіх початкових етапів, знайдених по вихідної таблиці заносяться значення раннього початку робіт рівні 0 і час раннього закінчення робіт 0 + тривалість виду робіт.
4.4. Для кожної заповненої таким чином рядка визначається етап закінчення виду робіт і його позначення запам'ятовується. З усіх видів робіт, які закінчуються на такий етап, виявляється вид, що має максимальне значення часу раннього закінчення роботи. Це значення також запам'ятовується. Далі в таблиці відшукуються види робіт, що починаються на раніше запомненний етап і для всіх записів, які відповідають умові у графу час раннього початку заноситься запам'ятоване максимальне значення часу раннього закінчення роботи. Алгоритм повторюється, поки не залишиться ні одного порожнього рядка.
4.5. У таблиці результатів, де для кожного виду робіт визначено час раннього початку та завершення, визначається максимальне значення часу раннього закінчення роботи, яке є тривалістю всього проекту.
4.6. Визначаються кінцеві етапи. Якщо в таблиці вихідних даних рядок не містить дані тривалості, значить, цим етапом не починається жоден вид робіт, тобто він кінцевий.
4.7. Для всіх кінцевих етапів, знайдених по вихідної таблиці заносяться значення пізнього завершення робіт рівні тривалості проекту і час пізнього початку робіт, рівне різниці тривалості проекту і тривалості виду робіт. Обчислюється повний резерв дорівнює різниці між пізнім і раннім часом закінчення (початку) робіт.
4.8. Для кожної заповненої таким чином рядка визначається етап початку виду робіт і його позначення запам'ятовується. З усіх видів робіт, що починаються на такий етап, виявляється вид, що має мінімальне значення часу пізнього початку роботи. Це значення також запам'ятовується. Далі в таблиці відшукуються види робіт, що закінчуються на раніше запомненний етап і для всіх записів, які відповідають умові у графу часу пізнього завершення заноситься запам'ятоване мінімальне значення часу пізнього початку роботи. Обчислюється повний резерв. Алгоритм повторюється, поки не залишиться ні одного порожнього рядка.
4.9. Виділяються записи, що мають значення повного резерву рівне 0. Такі види робіт входять в критичний шлях.
4.10. Для відшукання критичного шляху з першої зустрілася записи з повним резервом рівним нулю беруться значення початку і завершення виду робіт. Для всіх наступних записів береться тільки позначення етапу завершення виду робіт. Працездатність таким алгоритмом забезпечує структура розрахункової таблиці, де види робіт впорядковані за етапами їх початку. Однак якщо користувач пронумерує етапи у зворотному порядку, може статися так, що який-небудь етап зустрінеться в критичному шляху два рази, а інший ні разу. Для цього передбачений алгоритм пошуку повторюваних значень у критичному шляху. Якщо повторення виявлені, то програма будує критичний шлях у зворотному порядку. З останньої зустрілася записи з повним резервом рівним нулю беруться значення завершення і початку виду робіт. Для всіх наступних записів береться тільки позначення етапу початку виду робіт.
5. Результати обчислень виводяться на екран. Користувач може перевести одиниці часу в зворотному порядку (п. 3).

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

Визначимо критичний шлях на основі даних про зв'язки між етапами робіт і тривалості виконання робіт.
Нехай заданий граф.
SHAPE \ * MERGEFORMAT
2
1
4
3
6
8
5
7
10
9
2
3
1
3
6
5
5
1
4
2
3
2

На основі даних графа будується таблиця
Види робіт
Далі-
житель-
ність
Час раннього початку
Час раннього кінця
Час пізнього початку
Час пізнього кінця
Повний резерв
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
SHAPE \ * MERGEFORMAT
2
1
4
3
6
8
5
7
10
9
2
3
1
3
6
5
5
1
4
2
3
2

Критичний шлях: 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
Форма 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 (введення кількості етапів робіт, перевірка формату листа, перевірка правильності введення, виклик довідки, вихід з програми, перехід до розрахункової формі)
'Перевірка правильності введення
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
Форма Perevod 1 (запам'ятовування поточних одиниць часу)
'Запам'ятовування поточних одиниць часу
Private Sub CommandButton1_Click ()
If Minutes.Value = True Then
edin = 1
End If
If Chas.Value = True Then
edin = 2
End If
If Sutki.Value = True Then
edin = 3
End If
If Nedeli.Value = True Then
edin = 4
End If
If Mes.Value = True Then
edin = 5
End If
If Godi.Value = True Then
edin = 6
End If
Hide
Perevod2.Show
End Sub
Private Sub UserForm_Terminate ()
Hide
SolForm.StartUpPosition = 0
SolForm.Top = 350
SolForm.Left = 480
SolForm.Show
End Sub
Форма Perevod 2 (переклад одиниць часу, повернення до розрахункової формі)
'Переклад одиниць часу
Private Sub CommandButton1_Click ()
Hide
SolForm.Show
If ActiveSheet.Cells (1, 1). Value = "№" Then
If edin = 1 Then
If Minutes.Value = True Then
Exit Sub
End If
If Chas.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 60
End If
Next j
Next i
End If
If Sutki.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 1440
End If
Next j
Next i
End If
If Nedeli.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 10080
End If
Next j
Next i
End If
If Mes.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Godi.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 525600
End If
Next j
Next i
End If
End If
If edin = 2 Then
If Minutes.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 60
End If
Next j
Next i
End If
If Chas.Value = True Then
Exit Sub
End If
If Sutki.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 24
End If
Next j
Next i
End If
If Nedeli.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 168
End If
Next j
Next i
End If
If Mes.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Godi.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 8760
End If
Next j
Next i
End If
End If
If edin = 3 Then
If Minutes.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 1440
End If
Next j
Next i
End If
If Chas.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 24
End If
Next j
Next i
End If
If Sutki.Value = True Then
Exit Sub
End If
If Nedeli.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 7
End If
Next j
Next i
End If
If Mes.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Godi.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 365
End If
Next j
Next i
End If
End If
If edin = 4 Then
If Minutes.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 10080
End If
Next j
Next i
End If
If Chas.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 168
End If
Next j
Next i
End If
If Sutki.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 7
End If
Next j
Next i
End If
If Nedeli.Value = True Then
Exit Sub
End If
If Mes.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Godi.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
End If
If edin = 5 Then
If Minutes.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Chas.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Sutki.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Nedeli.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Mes.Value = True Then
Exit Sub
End If
If Godi.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 12
End If
Next j
Next i
End If
End If
If edin = 6 Then
If Minutes.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 525600
End If
Next j
Next i
End If
If Chas.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 8760
End If
Next j
Next i
End If
If Sutki.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 365
End If
Next j
Next i
End If
If Nedeli.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Mes.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 12
End If
Next j
Next i
End If
If Godi.Value = True Then
Exit Sub
End If
End If
End If
If ActiveSheet.Cells (1, 1). Value = "Початковий етап" Then
If edin = 1 Then
If Minutes.Value = True Then
Exit Sub
End If
If Chas.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 60
Next j
Next i
End If
If Sutki.Value = True Then
For i = 2 To scount
For j = 3 To 8
If Not ActiveSheet.Cells (i, j). Value = "" Then
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 1440
End If
Next j
Next i
End If
If Nedeli.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 10080
Next j
Next i
End If
If Mes.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Godi.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 525600
Next j
Next i
End If
End If
If edin = 2 Then
If Minutes.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 60
Next j
Next i
End If
If Chas.Value = True Then
Exit Sub
End If
If Sutki.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 24
Next j
Next i
End If
If Nedeli.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 168
Next j
Next i
End If
If Mes.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Godi.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 8760
Next j
Next i
End If
End If
If edin = 3 Then
If Minutes.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 1440
Next j
Next i
End If
If Chas.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 24
Next j
Next i
End If
If Sutki.Value = True Then
Exit Sub
End If
If Nedeli.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 7
Next j
Next i
End If
If Mes.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Godi.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 365
Next j
Next i
End If
End If
If edin = 4 Then
If Minutes.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 10080
Next j
Next i
End If
If Chas.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 168
Next j
Next i
End If
If Sutki.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 7
Next j
Next i
End If
If Nedeli.Value = True Then
Exit Sub
End If
If Mes.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Godi.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
End If
If edin = 5 Then
If Minutes.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Chas.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Sutki.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Nedeli.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Mes.Value = True Then
Exit Sub
End If
If Godi.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value / 12
Next j
Next i
End If
End If
If edin = 6 Then
If Minutes.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 525600
Next j
Next i
End If
If Chas.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 8760
Next j
Next i
End If
If Sutki.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 365
Next j
Next i
End If
If Nedeli.Value = True Then
MsgBox "Точний переклад неможливий. Спробуйте інший варіант", vbCritical + vbOKOnly, "Помилка вводу"
End If
If Mes.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells (i, j). Value = ActiveSheet.Cells (i, j). Value * 12
Next j
Next i
End If
If Godi.Value = True Then
Exit Sub
End If
End If
End If
End Sub
Private Sub UserForm_Terminate ()
Hide
SolForm.StartUpPosition = 0
SolForm.Top = 350
SolForm.Left = 480
SolForm.Show
End Sub
Форма SolForm (перевірка правильності заповнення таблиці, перевірка формату листа, перевірка наявності даних в аркуші результатів, виклик модуля формування та заповнення таблиці результатів)
Private Sub CommandButton1_Click ()
Dim Ans As String
Dim fl As Boolean
Dim cou As Integer
cou = 0
check = True
If Not ActiveSheet.Cells (1, 1). Value = "№" Then
Ans = MsgBox ("Лист не відформатовано для розрахунку, скористайтеся вікном введення даних", vbCritical + vbOKCancel, "Помилка")
If Ans = vbOK Then
Hide
InsForm.Show
Sheets ("Data"). Select
Exit Sub
End If
If Ans = vbCancel Then
Exit Sub
End If
End If
For i = 2 To n + 1
For j = 2 To n + 1
If Not IsNumeric (ActiveSheet.Cells (i, j). Value) Then
MsgBox "Тривалість роботи повинна виражатися числом!", VbCritical + vbOKOnly, "Помилка"
markcell
Exit Sub
End If
kn = ActiveSheet.Cells (i, j). Value
kk = Fix (ActiveSheet.Cells (i, j). Value)
If kk <kn Then
MsgBox "Дробові числа дають похибку при обчисленні! Скористайтеся перекладом одиниць часу, щоб отримати цілі числа.", VbCritical + vbOKOnly, "Помилка"
markcell
Exit Sub
End If
If Not ActiveSheet.Cells (i, j). Value = "" Then
If Not ActiveSheet.Cells (j, i). Value = "" Then
MsgBox "Є етапи, які замикаються самі на себе! Це призведе до зациклення програми!", VbCritical + vbOKOnly, "Помилка"
markcell
Exit Sub
End If
End If
Next j
If Not ActiveSheet.Cells (i, i). Value = "" Then
j = i
MsgBox "Точка відліку не повинна має тривалості", vbCritical + vbOKOnly, "Помилка"
markcell
Exit Sub
End If
Next i
For i = 2 To n + 1
fl = False
For j = 2 To n + 1
If Not ActiveSheet.Cells (j, i). Value = "" Then
fl = True
End If
Next j
If fl = True Then
cou = cou + 1
End If
Next i
If cou = n Then
MsgBox "Повинен бути хоча б один початковий етап!", VbCritical + vbOKOnly, "Помилка"
Exit Sub
End If
If cou = 0 Then
MsgBox "Повинен бути хоча б один кінцевий етап!", VbCritical + vbOKOnly, "Помилка"
Exit Sub
End If
If hlp = True Then
Hide
HelpForm2.Show
End If
If check = False Then
Exit Sub
End If
Application.ScreenUpdating = False
Sheets ("Rez"). Select
If Sheets ("Rez"). Cells (1, 1). Value = "Початковий етап" Then
Ans = MsgBox ("Лист Rez вже містить результати обчислень. Зберегти обчислення в іншому аркуші?", VbCritical + vbYesNo, "Інформація")
If Ans = vbYes Then
Sheets.Add
For i = 1 To 222
For j = 1 To 8
ActiveSheet.Cells (i, j). Value = Sheets ("Rez"). Cells (i, j). Value
Next j
Next i
RTable
End If
End If
Sheets ("Rez"). Select
Range ("A1: IV230"). Select
Selection.Clear
RTable
Sheets ("Data"). Select
Solut
Application.ScreenUpdating = True
Sheets ("Rez"). Select
End Sub
Private Sub CommandButton2_Click ()
Hide
InsForm.Start
InsForm.Show
Sheets ("Data"). Select
End Sub
Private Sub CommandButton6_Click ()
check = True
If Not ActiveSheet.Cells (1, 1). Value = "№" Then
If Not ActiveSheet.Cells (1, 1). Value = "Початковий етап" Then
MsgBox "Лист не відформатовано для розрахунку, скористайтеся вікном введення даних", vbCritical + vbOKOnly, "Помилка"
Hide
InsForm.Show
Sheets ("Data"). Select
Exit Sub
End If
End If
If hlp = True Then
Hide
HelpForm3.Show
End If
If check = False Then
Exit Sub
End If
Hide
Perevod1.Show
End Sub
Private Sub UserForm_Terminate ()
Hide
STF.Show
End Sub
Форма STF (вхід в програму, завершення роботи програми)
Private Sub CommandButton1_Click ()
Hide
InsForm.Show
Sheets ("Data"). Select
End Sub
Private Sub CommandButton2_Click ()
Answer = MsgBox ("Ви дійсно хочете завершити роботу?", VbYesNo + vbQuestion + vbDefaultButton2, "Завершення роботи")
If Answer = vbYes Then
ThisWorkbook.Saved = True
Application.Quit
End If
End Sub
Private Sub UserForm_Initialize ()
STF.Height = Application.Height
STF.Width = Application.Width
'STF.CommandButton1.Left = STF.Width / 4 - 36
'STF.CommandButton1.Top = STF.Top + 15
'STF.CommandButton2.Left = STF.Width / 2 - 10
'STF.CommandButton2.Top = STF.Top + 15
End Sub
Private Sub UserForm_Terminate ()
Answer = MsgBox ("Ви дійсно хочете завершити роботу?", VbYesNo + vbQuestion + vbDefaultButton2, "Завершення роботи")
If Answer = vbYes Then
ThisWorkbook.Saved = True
Application.Quit
End If
End Sub
Модуль Result (побудова таблиці результатів)
Sub RTable ()
Range ("A1: H1"). Select
With Selection.Font
. Name = "Arial Cyr"
. Size = 14
. Strikethrough = False
. Superscript = False
. Subscript = False
. OutlineFont = False
. Shadow = False
. Underline = xlUnderlineStyleNone
. ColorIndex = xlAutomatic
End With
With Selection
. HorizontalAlignment = xlCenter
. VerticalAlignment = xlBottom
. WrapText = True
. Orientation = 0
. AddIndent = False
. IndentLevel = 0
. ShrinkToFit = False
. ReadingOrder = xlContext
. MergeCells = False
End With
Range ("A1"). Select
ActiveCell.FormulaR1C1 = "Початковий етап"
With ActiveCell.Characters (Start: = 1, Length: = 14). Font
. Name = "Arial Cyr"
. FontStyle = "звичайний"
. Size = 14
. Strikethrough = False
. Superscript = False
. Subscript = False
. OutlineFont = False
. Shadow = False
. Underline = xlUnderlineStyleNone
. ColorIndex = xlAutomatic
End With
Range ("B1"). Select
Columns ("A: A"). ColumnWidth = 15
Range ("B1"). Select
ActiveCell.FormulaR1C1 = "Кінцевий етап"
With ActiveCell.Characters (Start: = 1, Length: = 13). Font
. Name = "Arial Cyr"
. FontStyle = "звичайний"
. Size = 14
. Strikethrough = False
. Superscript = False
. Subscript = False
. OutlineFont = False
. Shadow = False
. Underline = xlUnderlineStyleNone
. ColorIndex = xlAutomatic
End With
Range ("C1"). Select
Columns ("B: B"). ColumnWidth = 15
ActiveCell.FormulaR1C1 = "Далі-житель-ність"
With ActiveCell.Characters (Start: = 1, Length: = 20). Font
. Name = "Arial Cyr"
. FontStyle = "звичайний"
. Size = 14
. Strikethrough = False
. Superscript = False
. Subscript = False
. OutlineFont = False
. Shadow = False
. Underline = xlUnderlineStyleNone
. ColorIndex = xlAutomatic
End With
Range ("D1"). Select
Columns ("C: C"). ColumnWidth = 12
ActiveCell.FormulaR1C1 = "Час раннього початку"
With ActiveCell.Characters (Start: = 1, Length: = 20). Font
. Name = "Arial Cyr"
. FontStyle = "звичайний"
. Size = 14
. Strikethrough = False
. Superscript = False
. Subscript = False
. OutlineFont = False
. Shadow = False
. Underline = xlUnderlineStyleNone
. ColorIndex = xlAutomatic
End With
Range ("E1"). Select
Columns ("D: D"). ColumnWidth = 12
ActiveCell.FormulaR1C1 = "Час раннього кінця"
With ActiveCell.Characters (Start: = 1, Length: = 19). Font
. Name = "Arial Cyr"
. FontStyle = "звичайний"
. Size = 14
. Strikethrough = False
. Superscript = False
. Subscript = False
. OutlineFont = False
. Shadow = False
. Underline = xlUnderlineStyleNone
. ColorIndex = xlAutomatic
End With
Range ("F1"). Select
Columns ("E: E"). ColumnWidth = 12
ActiveCell.FormulaR1C1 = "Час пізнього початку"
With ActiveCell.Characters (Start: = 1, Length: = 21). Font
. Name = "Arial Cyr"
. FontStyle = "звичайний"
. Size = 14
. Strikethrough = False
. Superscript = False
. Subscript = False
. OutlineFont = False
. Shadow = False
. Underline = xlUnderlineStyleNone
. ColorIndex = xlAutomatic
End With
Range ("G1"). Select
Columns ("F: F"). ColumnWidth = 12
ActiveCell.FormulaR1C1 = "Час пізнього кінця"
With ActiveCell.Characters (Start: = 1, Length: = 20). Font
. Name = "Arial Cyr"
. FontStyle = "звичайний"
. Size = 14
. Strikethrough = False
. Superscript = False
. Subscript = False
. OutlineFont = False
. Shadow = False
. Underline = xlUnderlineStyleNone
. ColorIndex = xlAutomatic
End With
Range ("H1"). Select
Columns ("G: G"). ColumnWidth = 12
ActiveCell.FormulaR1C1 = "Повний резерв"
With ActiveCell.Characters (Start: = 1, Length: = 13). Font
. Name = "Arial Cyr"
. FontStyle = "звичайний"
. Size = 14
. Strikethrough = False
. Superscript = False
. Subscript = False
. OutlineFont = False
. Shadow = False
. Underline = xlUnderlineStyleNone
. ColorIndex = xlAutomatic
End With
Range ("I1"). Select
Columns ("H: H"). ColumnWidth = 11
Range ("A2"). Select
Rows ("1:1"). RowHeight = 55.5
End Sub
Модуль Solve (побудова таблиці початкових даних, знаходження критичного шляху і супутніх даних, виділення клітинки, яка містить невірну інформацію)
Public i As Integer
Public j As Integer
Public check As Boolean
Public edin As Integer
Public hlp As Boolean
Public st1 As String
Public st2 As String
Public stroka1 As String
Public stroka2 As String
Public scount As Integer
Public snum As Integer
Public n As Integer
'Модуль побудови таблиці
Sub InsData ()
st1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
h = n
If h> 26 Then
a = h \ 26
If h Mod 26 = 0 Then
stroka1 = Mid (st1, a - 1, 1)
Else
stroka1 = Mid (st1, a, 1)
End If
b = a * 26
c = h - b
If c = 0 Then c = c + 26
stroka2 = Mid (st1, c, 1)
st2 = stroka1 + stroka2
Else
st2 = Mid (st1, h + 1, 1)
End If
If h = 26 Then
st2 = Mid (st1, 26, 1)
End If
Range ("A1:" + Trim (st2) + Trim (Str (n + 1))). Select
With Selection.Font
. Name = "Arial Cyr"
. Size = 14
. Strikethrough = False
. Superscript = False
. Subscript = False
. OutlineFont = False
. Shadow = False
. Underline = xlUnderlineStyleNone
. ColorIndex = xlAutomatic
End With
Rows ("3:3"). RowHeight = 18
Range ("A1"). Select
ActiveCell.FormulaR1C1 = "№"
Range ("A2"). Select
ActiveCell.FormulaR1C1 = "1"
Range ("A3"). Select
ActiveCell.FormulaR1C1 = "2"
Range ("A2: A3"). Select
Selection.AutoFill Destination: = Range ("A2: A" + Trim (Str (n + 1))), Type: = xlFillDefault
Range ("A2: A" + Trim (Str (n + 1))). Select
Range ("B1"). Select
ActiveCell.FormulaR1C1 = "1"
Range ("C1"). Select
ActiveCell.FormulaR1C1 = "2"
Range ("B1: C1"). Select
Selection.AutoFill Destination: = Range ("B1:" + Trim (st2) + "1"), Type: = xlFillDefault
Range ("A1:" + Trim (st2) + Trim (Str (n + 1))). Select
With Selection
. HorizontalAlignment = xlCenter
. VerticalAlignment = xlBottom
. WrapText = False
. Orientation = 0
. AddIndent = False
. IndentLevel = 0
. ShrinkToFit = False
. ReadingOrder = xlContext
. MergeCells = False
End With
Range ("A1: A" + Trim (Str (n + 1)) + ", A1:" + Trim (st2) + "1"). Select
Range ("A1"). Activate
With Selection.Interior
. ColorIndex = 33
. Pattern = xlSolid
. PatternColorIndex = xlAutomatic
End With
Range ("A1:" + Trim (st2) + Trim (Str (n + 1))). Select
Selection.Borders (xlDiagonalDown). LineStyle = xlNone
Selection.Borders (xlDiagonalUp). LineStyle = xlNone
With Selection.Borders (xlEdgeLeft)
. LineStyle = xlContinuous
. Weight = xlThin
. ColorIndex = xlAutomatic
End With
With Selection.Borders (xlEdgeTop)
. LineStyle = xlContinuous
. Weight = xlThin
. ColorIndex = xlAutomatic
End With
With Selection.Borders (xlEdgeBottom)
. LineStyle = xlContinuous
. Weight = xlThin
. ColorIndex = xlAutomatic
End With
With Selection.Borders (xlEdgeRight)
. LineStyle = xlContinuous
. Weight = xlThin
. ColorIndex = xlAutomatic
End With
With Selection.Borders (xlInsideVertical)
. LineStyle = xlContinuous
. Weight = xlThin
. ColorIndex = xlAutomatic
End With
With Selection.Borders (xlInsideHorizontal)
. LineStyle = xlContinuous
. Weight = xlThin
. ColorIndex = xlAutomatic
End With
For i = 1 To n + 1
st1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
h = i
If h> 26 Then
a = h \ 26
If h Mod 26 = 0 Then
stroka1 = Mid (st1, a - 1, 1)
Else
stroka1 = Mid (st1, a, 1)
End If
b = a * 26
c = h - b
If c = 0 Then c = c + 26
stroka2 = Mid (st1, c, 1)
st2 = stroka1 + stroka2
Else
st2 = Mid (st1, h, 1)
End If
If h = 26 Then
st2 = Mid (st1, 26, 1)
End If
Range (Trim (st2) + Trim (Str (i))). Select
With Selection.Interior
. ColorIndex = 33
. Pattern = xlSolid
. PatternColorIndex = xlAutomatic
End With
Next i
Range ("C2"). Select
End Sub
Sub Solut ()
Dim fl As Boolean
Dim flag As Boolean
Dim remnach As Integer
Dim remkon As Integer
Dim remdl As Double
Dim maxdl As Double
Dim putt As Boolean
scount = 1
'Введення в таблицю результатів початкових даних
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
scount = scount + 1
Sheets ("Rez"). Cells (scount, 1). Value = i - 1
Sheets ("Rez"). Cells (scount, 2). Value = j - 1
Sheets ("Rez"). Cells (scount, 3). Value = ActiveSheet.Cells (i, j). Value
End If
Next j
Next i
'Пошук початкових етапів
For i = 2 To n + 1
fl = False
For j = 2 To n + 1
If Not ActiveSheet.Cells (j, i). Value = "" Then
fl = True
End If
Next j
If fl = False Then
For j = 2 To scount
If Sheets ("Rez"). Cells (j, 1). Value = i - 1 Then
Sheets ("Rez"). Cells (j, 4). Value = 0
Sheets ("Rez"). Cells (j, 5). Value = Sheets ("Rez"). Cells (j, 4). Value + Sheets ("Rez"). Cells (j, 3). Value
End If
Next j
End If
Next i
'Заповнення раннього початку і кінця
flag = True
Do While flag = True
flag = False
For i = 2 To scount
If Not Sheets ("Rez"). Cells (i, 4). Value = "" Then
remkon = Sheets ("Rez"). Cells (i, 2)
remdl = Sheets ("Rez"). Cells (i, 5)
For j = 2 To scount
If Sheets ("Rez"). Cells (j, 2). Value = remkon Then
If remdl <Sheets ("Rez"). Cells (j, 5). Value Then
remdl = Sheets ("Rez"). Cells (j, 5). Value
End If
End If
Next j
For j = 2 To scount
If Sheets ("Rez"). Cells (j, 1). Value = remkon Then
Sheets ("Rez"). Cells (j, 4). Value = remdl
Sheets ("Rez"). Cells (j, 5). Value = Sheets ("Rez"). Cells (j, 4). Value + Sheets ("Rez"). Cells (j, 3). Value
End If
Next j
End If
Next i
For i = 2 To scount
If Sheets ("Rez"). Cells (i, 4). Value = "" Then
flag = True
End If
Next i
Loop
'Визначення тривалості проекту
maxdl = Sheets ("Rez"). Cells (2, 5). Value
For i = 2 To scount
If maxdl <Sheets ("rez"). Cells (i, 5). Value Then
maxdl = Sheets ("rez"). Cells (i, 5). Value
End If
Next i
'Визначення кінцевих етапів
For i = 2 To n + 1
fl = False
For j = 2 To n + 1
If Not ActiveSheet.Cells (i, j). Value = "" Then
fl = True
End If
Next j
If fl = False Then
For j = 2 To scount
If Sheets ("Rez"). Cells (j, 2). Value = i - 1 Then
Sheets ("Rez"). Cells (j, 7). Value = maxdl
Sheets ("Rez"). Cells (j, 6). Value = Sheets ("Rez"). Cells (j, 7). Value - Sheets ("Rez"). Cells (j, 3). Value
Sheets ("Rez"). Cells (j, 8). Value = Sheets ("Rez"). Cells (j, 7). Value - Sheets ("Rez"). Cells (j, 5). Value
End If
Next j
End If
Next i
'Заповнення пізнього початку і кінця
flag = True
Do While flag = True
flag = False
For i = scount To 2 Step -1
If Not Sheets ("Rez"). Cells (i, 6). Value = "" Then
remnach = Sheets ("Rez"). Cells (i, 1)
remdl = Sheets ("Rez"). Cells (i, 6)
For j = scount To 2 Step -1
If Sheets ("Rez"). Cells (j, 1). Value = remnach Then
If remdl> Sheets ("Rez"). Cells (j, 6). Value Then
remdl = Sheets ("Rez"). Cells (j, 6). Value
End If
End If
Next j
For j = scount To 2 Step -1
If Sheets ("Rez"). Cells (j, 2). Value = remnach Then
Sheets ("Rez"). Cells (j, 7). Value = remdl
Sheets ("Rez"). Cells (j, 6). Value = Sheets ("Rez"). Cells (j, 7). Value - Sheets ("Rez"). Cells (j, 3). Value
Sheets ("Rez"). Cells (j, 8). Value = Sheets ("Rez"). Cells (j, 7). Value - Sheets ("Rez"). Cells (j, 5). Value
End If
Next j
End If
Next i
For i = 2 To scount
If Sheets ("Rez"). Cells (i, 6). Value = "" Then
flag = True
End If
Next i
Loop
'Виявлення критичних етапів
Sheets ("Rez"). Select
For i = 2 To scount
If Sheets ("Rez"). Cells (i, 8). Value = 0 Then
Range ("A" + Trim (Str (i)) + ": H" + Trim (Str (i))). Select
With Selection.Interior
. ColorIndex = 35
. Pattern = xlSolid
. PatternColorIndex = xlAutomatic
End With
End If
Next i
Sheets ("Rez"). Cells (scount + 2, 1). Value = "Критичний шлях:"
'Побудова критичного шляху
snum = 1
For i = 2 To scount
If Sheets ("Rez"). Cells (i, 8). Value = 0 Then
Sheets ("Rez"). Cells (scount + 2, 2). Value = Sheets ("Rez"). Cells (i, 1). Value
Sheets ("Rez"). Cells (scount + 2, 3). Value = Sheets ("Rez"). Cells (i, 2). Value
snum = 3
remdl = i
i = scount
End If
Next i
For i = remdl To scount
If Sheets ("Rez"). Cells (i, 8). Value = 0 Then
Sheets ("Rez"). Cells (scount + 2, snum). Value = Sheets ("Rez"). Cells (i, 2). Value
snum = snum + 1
End If
Next i
putt = False
For i = 2 To snum - 1
remdl = Sheets ("Rez"). Cells (scount + 2, i)
For j = i + 1 To snum
If Sheets ("Rez"). Cells (scount + 2, j). Value = remdl Then
putt = True
End If
Next j
Next i
If putt = True Then
snum = 1
For i = scount To 2 Step -1
If Sheets ("Rez"). Cells (i, 8). Value = 0 Then
Sheets ("Rez"). Cells (scount + 2, 2). Value = Sheets ("Rez"). Cells (i, 1). Value
Sheets ("Rez"). Cells (scount, 3). Value = Sheets ("Rez"). Cells (i, 2). Value
snum = 3
remdl = i
i = 2
End If
Next i
For i = remdl To 2 Step -1
If Sheets ("Rez"). Cells (i, 8). Value = 0 Then
Sheets ("Rez"). Cells (scount + 2, snum). Value = Sheets ("Rez"). Cells (i, 2). Value
snum = snum + 1
End If
Next i
End If
Sheets ("Rez"). Cells (scount + 2, 1). Select
End Sub
Sub markcell ()
Dim mst1 As String
Dim mst2 As String
Dim mstroka1 As String
Dim mstroka2 As String
mst1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
h = j
If h> 26 Then
a = h \ 26
If h Mod 26 = 0 Then
mstroka1 = Mid (mst1, a - 1, 1)
Else
mstroka1 = Mid (mst1, a, 1)
End If
b = a * 26
c = h - b
If c = 0 Then c = c + 26
mstroka2 = Mid (mst1, c, 1)
mst2 = mstroka1 + mstroka2
Else
mst2 = Mid (mst1, h, 1)
End If
If h = 26 Then
mst2 = Mid (mst1, 26, 1)
End If
Range (Trim (mst2) + Trim (Str (i))). Select
End Sub
Додати в блог або на сайт

Цей текст може містити помилки.

Економіко-математичне моделювання | Курсова
144.2кб. | скачати


Схожі роботи:
Використання MS Project для визначення критичного шляху проекту
Знаходження коренів рівняння методом Ньютона ЛИСП-реалізація
Знаходження коренів рівняння методом простої ітерації ЛИСП-реалізація
Розвязання задач графічним методом методом потенціалів методом множників Лангранжа та симплекс-методом
Розвязання рівнянь методом оберненої матриці та методом Гауса
Особливості роботи з табличним процесором Excel
Організація та методика проведення уроку з теми Професійна робота з табличним редактором MS Excel 2
Організація та методика проведення уроку з теми Професійна робота з табличним редактором MS Excel
Енергія критичного судження
© Усі права захищені
написати до нас