Решение задач симплексным методом (стр. 3 из 4)
CommandButton1.Font = Bold
CommandButton1.Font.Size = 12
CommandButton1.Top = 1.5
CommandButton1.Left = 0.75
CommandButton1.Height = 24
CommandButton1.Width = 204
CommandButton2.ForeColor = &H8000& ’Зеленый
CommandButton2.Font = Bold
CommandButton2.Font.Size = 12
CommandButton2.Top = 1.5
CommandButton2.Left = 204
CommandButton2.Height = 24
CommandButton2.Width = 186
MiCiXiAi = CleaDoub
Rez = CleaTMY
Tsimp = CleaDoub
CommandButton2.Visible = False
Sheets(2).Name = “Пусто”
Sheets(2).Tab.ColorIndex = 6
‘Скроем все листы кроме первого. Первый лист переименуем в исходные данные.
‘We shall Hide all sheets except the first. The First sheet shall name “Initial data”.
‘For i = 3 To Sheets.Count
‘ Sheets(i).Visible = False
‘ Sheets(i).Visible = True
‘Next i
Sheets(1).Name = “Initial data”
‘определение количество строк с ограничениями
‘вычисление максимального индеха переменной Х (записіваем в MaxX).
‘Determination amount lines with restrictions
‘calculation the largest number variable X (record in MaxX).
Ftarget = Range(”A3″).Value
ProcString Ftarget, Rez, True
i = i
Isx = Trim(Range(”A9″).Value)
Do While Isx <> “”
ProcString Isx, Rez, True ’if True, then calculate MaxX
i = i + 1
Acell = “A” & CStr(i +
Isx = Trim(Range(Acell).Value)
Loop
AmRest = i - 1
‘Получение значений целевой функции в массиве Rez
‘Reception of importances of the target function in array Rez
Ftarget = Range(”A3″).Value
ProcString Ftarget, Rez, False
i = InStr(Ftarget, “=”)
If i = 0 Then
MsgBox (”В целевой функции нет знака = “)
End
End If
If Mid(Ftarget, i + 1, 3) = “min” Then
MaxLi = False
ElseIf Mid(Ftarget, i + 1, 3) = “max” Then
MaxLi = True
Else
MsgBox (”В целевой функции нет ни ‘max’ ни ‘min’ “)
End
End If
‘ Запись значений целевой функции в симплекс таблицу
‘We write values of the target function in simplex table
ReDim Preserve Tsimp(AmRest + 3, MaxX)
ReDim Preserve MiCiXiAi(AmRest, 4)
For i = 1 To UBound(Rez)
j = Rez(i).IndX
Tsimp(0, j) = Rez(i).KoefX
Next
‘Получение значений условий в массиве Rez и запись их значения в симплекс таблицу
‘Reception of importances of the conditions in array Rez and record of their values in simplex table
For K = 1 To AmRest
Acell = “A” & CStr(K +
Isx = Range(Acell).Value
ProcString Isx, Rez, False
For i = 1 To UBound(Rez)
j = Rez(i).IndX
Tsimp(K, j) = Rez(i).KoefX
Next i
Tsimp(K, 0) = Mid(Isx, BgRight) ’Правая часть ограничения. Right part of restriction.
St1 = Mid(Isx, BgRight - 1, 1)
‘ Если свободный член отрицателен, то следует изменить все значения на линии “K” в противоположном значении.
‘ If free member negative, that follows to change all importances on lines “K” in opposite importance
If Tsimp(K, 0) < 0 Then
For i = 0 To AmRest
Tsimp(K, i) = -Tsimp(K, i)
Next i
If St1 = “>” Then
St1 = “<”
ElseIf St1 = “<” Then
St1 = “>”
End If
End If
If St1 = “>” Then ‘ Если больше добавим 2 искуственных неизвестных
MaxX = MaxX + 2
ReDim Preserve Tsimp(AmRest + 3, MaxX)
Tsimp(K, MaxX - 1) = -1
Else ’Ограничение на равно или меньше
MaxX = MaxX + 1
ReDim Preserve Tsimp(AmRest + 3, MaxX)
End If
Tsimp(K, MaxX) = 1
If MaxLi And (St1 = “>” Or St1 = “=”) Then ’ Если махимум, в целевую функцию добавляем -Mxi, иначе +Mxi
Tsimp(AmRest + 3, MaxX) = -1 ‘ для > или =
ElseIf (Not MaxLi) And (St1 = “>” Or St1 = “=”) Then
Tsimp(AmRest + 3, MaxX) = 1
End If
MiCiXiAi(K, 1) = Tsimp(AmRest + 3, MaxX)
MiCiXiAi(K, 3) = MaxX
Next K
‘ Вычисление оценки
For j = 0 To MaxX
Vdbl = 0
For i = 1 To AmRest
Vdbl = Vdbl + MiCiXiAi(i, 1) * Tsimp(i, j)
Next i
Tsimp(AmRest + 1, j) = Vdbl - Tsimp(AmRest + 3, j)
Tsimp(AmRest + 2, j) = -Tsimp(0, j)
Next j
FRowCol
If Cycle() Then
MsgBox (”Неизвестная ошибка”)
End If
If Icol > 0 And Irow > 0 Then
LookResult “Каноническая таблица”, 31
ElseIf Icol > 0 And Irow <= 0 Then
LookResult “Функция не ограничена”, 28
Else
LookResult “Итерация невозможна”, 3
End If
End Sub
Private Sub LookResult(Sname As String, Fcolor As Integer)
‘Sheets(2).Tab.ColorIndex = 4
‘ Fcolor= 4-зеленый, 3-Красный, 37-Серосиний, 6-Желтый
‘ На втором листе начиная с ячейки A11 построим симплекс таблицу
‘ Вначале сделаем рамку
‘CreFrame(Vtop As Integer, Vleft As Integer, Vbottom As Integer, Vright As Integer)
Dim i As Integer, j As Integer
Dim Stk As String
Dim Sround As String
Sheets(2).Name = Sname
Sheets(2).Tab.ColorIndex = Fcolor
Sheets(2).Range(”a:iv”).Clear
CreFrame 11, 4, 11, MaxX + 3
CreFrame 12, 1, 12, MaxX + 4
CreFrame 12, 1, 12, 2
CreFrame 12, 4, 12, MaxX + 3
CreFrame 13, 1, 12 + AmRest, MaxX + 4
CreFrame 13, 4, 12 + AmRest, MaxX + 3
CreFrame 13, 3, 12 + AmRest, 3
CreFrame 13 + AmRest, 3, 13 + AmRest, MaxX + 4
CreFrame 13 + AmRest, 4, 13 + AmRest, MaxX + 3
CreFrame 14 + AmRest, 3, 14 + AmRest, MaxX + 4
CreFrame 14 + AmRest, 4, 14 + AmRest, MaxX + 3
‘Заполнение шапки симплексной таблицы
‘Filling the hat of the simplex table
For i = 0 To MaxX
Sheets(2).Cells(12, i + 3).Value = “X” + CStr(i)
Next i
If MaxLi Then Sheets(2).Cells(11, 3).Value = “F(Max)” Else Sheets(2).Cells(11, 3).Value = “F(Min)”
Sheets(2).Cells(12, 1).Value = “Сi”
Sheets(2).Cells(12, 2).Value = “P” + CStr(NumIter - 1)
Sheets(2).Cells(12, MaxX + 4).Value = “Alfa”
Sheets(2).Cells(13 + AmRest, 2).Value = “M–>”
‘Заполнение симплексной таблицы коэффициентами целевой функции
‘Filling the simplex table factor to target function
For j = 1 To MaxX
If Tsimp(AmRest + 3, j) = 0 Then
Sheets(2).Cells(11, j + 3).Value = Tsimp(0, j)
Else
If Tsimp(AmRest + 3, j) > 0 Then Sheets(2).Cells(11, j + 3).Value = ” M” Else Sheets(2).Cells(11, j + 3).Value = ” -M”
End If
Next j
‘Формирование первой, второй и последней колонок симплексной таблицы
‘Shaping first, second and last columnы of the simplex table
For i = 1 To AmRest
If MiCiXiAi(i, 1) = 0 Then
Sheets(2).Cells(12 + i, 1).Value = MiCiXiAi(i, 2)
ElseIf MiCiXiAi(i, 1) > 0 Then
Sheets(2).Cells(12 + i, 1).Value = ” M”
Else
Sheets(2).Cells(12 + i, 1).Value = ” -M”
End If
Sheets(2).Cells(12 + i, 2).Value = MiCiXiAi(i, 3)
Sheets(2).Cells(12 + i, MaxX + 4).Value = MiCiXiAi(i, 4)
Next i
‘Заполнение симплексной таблицы коэфициентами ограничений
‘Filling the simplex table koefficient restrictions
For i = 1 To AmRest + 2
For j = 0 To MaxX
Sheets(2).Cells(12 + i, j + 3).Value = Tsimp(i, j)
Next j
Next i
If Icol > 0 Then
‘ColourFrame(Vtop, Vleft, Vbottom, Vright, Vcolour=34)
ColourFrame 11, Icol + 3, AmRest + 14, Icol + 3, 34
End If
If Irow > 0 Then
ColourFrame Irow + 12, 2, Irow + 12, MaxX + 4, 34
End If
‘Информация об итерации или канонической таблице
‘Information on iterations or canonical table
If Fcolor = 31 Or Fcolor = 3 Then
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