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

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

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