Для получения новой итерации следует перейти на первый лист(он называется “Initial data” и нажать кнопку для получения следующей итерации. Если промежуточные результаты не нужны, то следует последовательно нажимать на кнопку получения новой итерации, не переходя на второй лист и перейти на него только для просмотра окончательного результата.

 

6. ТЕКСТ ИСХОДНОГО МОДУЛЯ

Dim Ftarget As String  ’целевая функция target function

Dim MaxX As Integer ‘максимальный  индех Х в целевой функции

Dim MaxLi As Boolean ‘true-max; False-min

Dim AmRest As Integer ‘ Количество строк ограничений (Amount of the restrictions)

Private Type Tmy

IndX As Integer

KoefX As Double

End Type

‘Номер очередного обрабатываемого символа в строке

Dim Icurrent As Integer

Dim BgRight As Integer  ’Номер байта начала правой части ограничения, иначе 0;

‘The Number of the byte begin right part of restriction, otherwise 0;

Dim Isx As String

Dim Rez() As Tmy

Dim NumIter As Integer ‘Номер итерации. Если равен нулю, канонический вид симплекс таблицы

‘Number to iterations. If is a zero, canonical type simplex tables

Dim MiCiXiAi() As Double ‘Два  первых столбца этого массива  заменяют первый столбец симплексной  таблицы.

‘Первый столбец, это  множитель “М”, вводимый для искуственных переменных для ограничений “>” или “=”

‘Второй столбец, это  коэфициенты переменных в целевой  функции

‘(номера этих переменных указаны в третьем столбце  массива MiCiXiAi)

‘Четвертый столбец  массива MiCiXiAi(”Alfa”), это последний  столбец симплексной таблицы равный X0/Хi

‘Two first columns of this array change the first column of the simplex table.

‘First column, this multiplier “M”, introduced for illusory variables for restrictions “>” or “=”

‘Second column, this values from target function

‘Second column is values variables in target function

‘(number these variables is specified in one third column array MiCiXiAi)

‘Fourth column of the array MiCiXiAi(”Alfa”), this last column of the simplex table equal X0/Hi

Dim Tsimp() As Double   ‘ the simplex table

Dim CleaDoub() As Double

Dim CleaTMY() As Tmy

Dim Icol As Integer  ’ Ключевой столбец.The Key column.

Dim Irow As Integer  ’ Ключевая строка. The Key line.

Dim AllPlans As String    ’Все планы в текущей задаче. All plans in the current task.

Dim DirectCycle As Boolean ‘True-Прямой цикл; True-Direct cycle;

Private Sub ProcString(Strin As String, Ans() As Tmy, CalcMaxX As Boolean)

‘Выделение из “Strin”  числовых данных. Одновременно вычисляем  махимальный индех переменно Х

‘Separation from “Strin” numeric data. Simultaneously we calculate the Largest number variable X.

Dim Awork() As Tmy

Dim VaLi As Double

Dim i As Integer  ’ index in awork

Strin = Replace(Strin, ” “,  “”) ‘ Убрали лишьние пробелы  в целевой функции

Strin = Trim(Strin)

Strin = Replace(Strin, “X”,  “x”) ‘Заменим все х на маленькое  английское

Strin = Replace(Strin, “Х”,  “x”) ‘Русское большое на маленькое  английское x

Strin = Replace(Strin, “х”,  “x”) ‘Русское маленькое на  маленькое английское x

Strin = Replace(Strin, “>=”,  “>”) ‘

Strin = Replace(Strin, “<=”,  “<”) ‘

BgRight = 0

i = 0

Icurrent = 1

Do While BgRight = 0

i = i + 1

ReDim Preserve Awork(i)

VaLi = ExtractDbl(Strin, Icurrent)

Awork(i).KoefX = VaLi

VaLi = ExtractDbl(Strin, Icurrent)

Awork(i).IndX = CInt(VaLi)

If CalcMaxX Then If MaxX < CInt(VaLi) Then MaxX = CInt(VaLi)

Loop

Ans = Awork

End Sub

Private Sub CommandButton1_Click()

Dim i As Integer

Dim j As Integer

Dim K As Integer

Dim Acell As String

Dim St1 As String * 1

Dim Vdbl As Double

NumIter = 0

MaxX = 0

AllPlans = “”

DirectCycle = True

CommandButton1.ForeColor = &H40C0&  ’Оранжевый

CommandButton1.Caption = “Привести  к каноническому виду”

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