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

.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

 Скачать реферат