Автор работы: Пользователь скрыл имя, 12 Ноября 2009 в 19:06, Не определен
курсовик VBA
Stk = “Начальная симплекс таблица задачи на ”
Stk = Stk & IIf(MaxLi, “максимум”, “минимум”) & “, приведенной к каноническому виду.”
With Sheets(2).Range(”A1″)
.Font.FontStyle = “Bold”
.Value = Stk
End With
Stk = IIf(Fcolor = 31, “Возможно улучшение плана.”, “Итерация невозможна(Видимо протероречивые условия).”)
Sheets(2).Range(”A2″).Value = Stk
Stk = “Разрешающий столбец определяется по двум последним строкам таблицы.”
Sheets(2).Range(”A3″).Value = Stk
Stk = “В пересечении колонок Х0-Х” & CStr(MaxX)
Stk = Stk & IIf(MaxLi, “(выбирается
максимальное по модулю
Sheets(2).Range(”A4″).Value = Stk
Stk = “Сначала просматривается
строка помеченная знаком “”M–>
Sheets(2).Range(”A5″).Value = Stk
Stk = ” и если в ней нет ” & IIf(MaxLi, “отрицательных”, “положительных”) & “чисел, просматривается последняя строка.”
Sheets(2).Range(”A6″).Value = Stk
Stk = “Если разрешающий
столбец не нашли, то в
Sheets(2).Range(”A7″).Value = Stk
Stk = “Разрешающая
строка определяется по
Sheets(2).Range(”A8″).Value = Stk
Stk = “коэффициентов
столбца Х0 и разрешающего
Sheets(2).Range(”A9″).Value = Stk
ElseIf Fcolor = 50 Then
Sheets(2).Range(”A1:A10″).
Stk = “После итерации №” & CStr(NumIter - 1) & “(возможно улучшение плана) ”
With Sheets(2).Range(”A6″)
.Font.FontStyle = “Bold”
.Value = Stk
End With
i = IIf(Tsimp(AmRest + 1, Icol) = 0, 1, 2)
Stk = “Так как в ” & IIf(i = 1, “последней”, “предпоследней”) & “строке(начиная с колонки Х1)”
Sheets(2).Range(”A7″) = Stk
Stk = IIf(MaxLi, “(имеется
максимальное по модулю
Sheets(2).Range(”A8″) = Stk
Stk = “А в столбце
“”Alfa”" имеется не
Sheets(2).Range(”A9″) = Stk
ElseIf Fcolor = 37 Then
Stk = “После итерации №” & CStr(NumIter - 1) & ” получили оптимальный план. ”
j = IIf(Trim(CStr(Sheets(1).Range(
With Sheets(2).Range(”A5″)
.Font.FontStyle = “Bold”
.Value = Stk
End With
Sround = IIf(j = -1, CStr(Tsimp(AmRest + 2, 0)), CStr(Round(Tsimp(AmRest + 2, 0), j)))
Stk = “Для функции ” & Ftarget & ” результат равный ” & Sround
Sheets(2).Range(”A6″).Value = Stk
Stk = “Достигается при ”
For i = 1 To AmRest
If MiCiXiAi(i, 2) <> 0 Then
Sround = IIf(j = -1, CStr(Tsimp(i, 0)), CStr(Round(Tsimp(i, 0), j)))
Stk = Stk & “X” & CStr(MiCiXiAi(i, 3)) & “=” & Sround & “;”
End If
Next i
Sheets(2).Range(”A7″).Value = Stk
Stk = “Номера переменных Х и их значения находятся, соответственно, во второй и третьей колонках симплекс таблицы”
Sheets(2).Range(”A8″).Value = Stk
Stk = “Оптимальный план находится в первой ячейке последней строки симплекс таблицы”
Sheets(2).Range(”A9″).Value = Stk
End If
‘Округление Truncation
‘Количество знаков в дробной части в символьном виде
‘Amount sign in fractional part in symbol type
If Trim(CStr(Sheets(1).Range(”A5″
j = CInt(Sheets(1).Range(”A5″).
Sround = “0.”
For i = 1 To j
Sround = Sround & “0″
Next i
Stk = “C13:” & R1C1_to_A1(AmRest + 12, MaxX + 3)
Sheets(2).Range(Stk).
Stk = R1C1_to_A1(AmRest + 14, 3)
Sheets(2).Range(Stk).
End If
‘Viewing Canonical type
End Sub
Function ExtractDbl(Stk As String, ByVal iBg As Integer) As Double
‘поиск номера неизвестного xi(то есть вычисление i)
‘ номер i начинается от символа с номером iBg(включительно) и продолжается до одного из символов: +, -, =, >, <
‘Searching for of the number unknown xi(that is to say calculation i).
‘Number i begins from symbol with number iBg(inclusive) and lasts before one of the symbol: +, -, =, >, <
Dim SimIbg As String * 1
Dim i As Integer
Dim St1 As String * 1
For i = iBg To Len(Stk)
St1 = Mid(Stk, i, 1)
If i = iBg Then SimIbg = St1
If St1 = “x” Then
Icurrent = i + 1
Exit For
ElseIf (St1 = “+” Or St1 = “-”) And i <> iBg Then
Icurrent = i
Exit For
ElseIf St1 = “=” Or St1 = “>” Or St1 = “<” Then
Icurrent = i + 1
BgRight = i + 1
Exit For
End If
Next i
If i > Len(Stk) Then
MsgBox (”osibka in “”" & Stk & “”"”)
End
End If
If iBg = i Then
ExtractDbl = 1
ElseIf (i - iBg) = 1 And (SimIbg = “+” Or SimIbg = “-”) Then
If SimIbg = “+” Then ExtractDbl = 1 Else ExtractDbl = -1
Else
ExtractDbl = CDbl(Mid(Stk, iBg, i - iBg))
End If
End Function
‘Процедура CreFrame обрамляет область листа заданную кординатами
‘верхнего левого угла и координатами нижнего правого угла
‘ Procedure CreFrame does frame of the area of the sheet
‘given by coordinates of the upper left corner and coordinates of the right lower corner
Sub CreFrame(Vtop As Integer, Vleft As Integer, Vbottom As Integer, Vright As Integer)
Dim Stk As String
Stk = R1C1_to_A1(Vtop, Vleft) & “:” & R1C1_to_A1(Vbottom, Vright)
With Sheets(2).Range(Stk)
.Borders(xlEdgeLeft).Weight = xlThick
.Borders(xlEdgeRight).Weight = xlThick
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlInsideVertical).
.Borders(xlInsideHorizontal).
End With
End Sub
‘Процедура ColourFrame заполняет цветом область листа заданного координатами
‘верхнего левого угла и координатами правого нижнего угла
‘ The Procedure ColourFrame fills the colour an area sheet given by coordinates
‘ of the upper left corner and coordinates of the right lower corner.
Sub ColourFrame(Vtop As Integer, Vleft As Integer, Vbottom As Integer, Vright As Integer, Vcolour As Integer)
Dim Stk As String
Stk = R1C1_to_A1(Vtop, Vleft) & “:” & R1C1_to_A1(Vbottom, Vright)
Sheets(2).Range(Stk).Interior.
‘ .ColorIndex = 34 ‘Vcolour there is number of the colour in color scheme.
End Sub
Function R1C1_to_A1(Vrow As Integer, Vcol As Integer) As String
V26 = “ABCDEFGHIJKLMNOPQRSTUVWXVZ”
Dim Stk As String
If Vcol > 26 Then
Stk = Mid(V26, Int(Vcol / 26), 1) + Mid(V26, (Vcol Mod 26), 1) + CStr(Vrow)
Else
Stk = Mid(V26, Vcol, 1) + CStr(Vrow)
End If
R1C1_to_A1 = Stk
End Function
Private Sub CalcColB()
‘Вычисление ключевого столбца по найбольшей оценке(когда min)
‘Calculation key column on the largest estimation(when min)
Dim i As Integer
Dim WrcM As Double, IrcM As Integer
Dim WrcC As Double, IrcC As Integer
WrcM = 0
WrcC = 0
For i = 1 To MaxX
If Tsimp(AmRest + 1, i) > WrcM Then
WrcM = Tsimp(AmRest + 1, i)
IrcM = i
ElseIf Tsimp(AmRest + 2, i) > WrcC And Tsimp(AmRest + 1, i) = 0 Then
WrcC = Tsimp(AmRest + 2, i)
IrcC = i
End If
Next i
If WrcM > 0 Then
Icol = IrcM
ElseIf WrcC > 0 Then
Icol = IrcC
Else
Icol = 0
End If
End Sub
Private Sub CalcColL()
‘Вычисление ключевого столбца по отрицательной(максимальной по модулю) оценке(когда max)
‘Calculation key column on negative(maximum modulo) to estimation(when max)
Dim i As Integer
Dim WrcM As Double, IrcM As Integer
Dim WrcC As Double, IrcC As Integer
WrcM = 0
WrcC = 0
For i = 1 To MaxX
If Tsimp(AmRest + 1, i) < 0 And Abs(Tsimp(AmRest + 1, i)) > WrcM Then
WrcM = Abs(Tsimp(AmRest + 1, i))
IrcM = i
ElseIf (Tsimp(AmRest + 2, i) < 0) And (Abs(Tsimp(AmRest + 2, i)) > WrcC) And (Tsimp(AmRest + 1, i) = 0) Then
WrcC = Abs(Tsimp(AmRest + 2, i))
IrcC = i
End If
Next i
If WrcM > 0 Then
Icol = IrcM
ElseIf WrcC > 0 Then
Icol = IrcC
Else
Icol = 0
End If
End Sub
Private Sub CalcRow()
‘Вычисление ключевой строки по положительному минимум отношения X0/Xi
‘Calculation of the key line on positive minimum relations X0/Xi
Dim Cslave As Double, Islave As Integer
Dim Wrk As Double
If Icol = 0 Then
For i = 1 To AmRest
MiCiXiAi(i, 4) = -1
‘MiCiXiAi(i, 4) = Nothing
Next i
Irow = 0
Else
Cslave = -1
Islave = 0
For i = 1 To AmRest
If Tsimp(i, Icol) <> 0 Then
If Tsimp(i, 0) = 0 Then
Wrk = IIf(Sgn(Tsimp(i, Icol)) = 1, 0, -1)
Else
Wrk = Tsimp(i, 0) / Tsimp(i, Icol)
End If
MiCiXiAi(i, 4) = Wrk
If Wrk >= 0 And Islave = 0 Then
Cslave = Wrk
Islave = i
ElseIf Wrk >= 0 Then
If DirectCycle Then
If Wrk < Cslave Then ’оставлять из равных первый
Cslave = Wrk
Islave = i
End If
Else
If Wrk <= Cslave Then ‘оставлять из равных последний
Cslave = Wrk
Islave = i
End If
End If
End If
Else
MiCiXiAi(i, 4) = -1
End If
Next i
Irow = Islave
End If
End Sub
Private Sub CommandButton2_Click()
‘Совершить итерацию
Dim Welm As Double
MiCiXiAi(Irow, 1) = Tsimp(AmRest + 3, Icol)
MiCiXiAi(Irow, 2) = Tsimp(0, Icol)
MiCiXiAi(Irow, 3) = Icol
Welm = Tsimp(Irow, Icol)
For i = 1 To AmRest + 2
If i <> Irow Then
For j = 0 To MaxX
If j <> Icol Then
Tsimp(i, j) = Tsimp(i, j) - (Tsimp(i, Icol) / Welm) * Tsimp(Irow, j)
End If
Next j
End If
Next i
For j = 0 To MaxX
Tsimp(Irow, j) = Tsimp(Irow, j) / Welm
Next j
For i = 1 To AmRest + 2
Tsimp(i, Icol) = 0
Next i
Tsimp(Irow, Icol) = 1
FRowCol
If Cycle() Then
LookResult “Итерации зациклились на итерации №” & CStr(NumIter - 1), 11
ElseIf Icol > 0 And Irow > 0 Then
LookResult “Смотри итерацию №” & CStr(NumIter - 1), 50
ElseIf Icol > 0 And Irow <= 0 Then
LookResult “Функция не ограничена”, 28
Else
LookResult “Оптимальный план”, 37
End If
End Sub
Private Sub FRowCol()
‘Поиск разрешающих строки и столбца
If MaxLi Then
CalcColL ’max
Else
CalcColB ’ min
End If
CalcRow ’X0/Xi
If Icol > 0 And Irow > 0 Then
CommandButton2.Visible = True
NumIter = NumIter + 1
CommandButton2.Caption = “Произвести итерацию №” & CStr(NumIter)
Else
NumIter = NumIter + 1
CommandButton2.Visible = False
End If
End Sub
Private Function Cycle() As Boolean ‘Если “Верно” зациклились. If “True” were looped.