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