Симплекс метод в Excel

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 и разрешающего столбца(что  представлено в столбце Alfa).”

Sheets(2).Range(”A9″).Value = Stk

ElseIf Fcolor = 50 Then

Sheets(2).Range(”A1:A10″).ClearContents

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(”A5″).Value)) <> “”, CInt(Sheets(1).Range(”A5″).Value), -1) ‘j=-1 Without truncation

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″).Value)) <> “” Then

j = CInt(Sheets(1).Range(”A5″).Value)

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).NumberFormat = Sround

Stk = R1C1_to_A1(AmRest + 14, 3)

Sheets(2).Range(Stk).NumberFormat = Sround

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).Weight = xlThin

.Borders(xlInsideHorizontal).Weight = xlThin

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 = Vcolour  ’Vcolour есть номер цвета в цветовой схеме.

‘       .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.