Модуль 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
Популярное: Личность ребенка как объект и субъект в образовательной технологии: В настоящее время в России идет становление новой системы образования, ориентированного на вхождение... Почему стероиды повышают давление?: Основных причин три... Модели организации как закрытой, открытой, частично открытой системы: Закрытая система имеет жесткие фиксированные границы, ее действия относительно независимы... ©2015-2024 megaobuchalka.ru Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав. (162)
|
Почему 1285321 студент выбрали МегаОбучалку... Система поиска информации Мобильная версия сайта Удобная навигация Нет шокирующей рекламы |