Реализация программного модуля, на встроенном языке программирования Visual Basic for Application (VBA), страница 12

Dim metka1(1 To 7, 1 To 7) As String

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

metka1(i, j) = "."

Next j

Next i

Dim postavka(1 To 7, 1 To 7) As Double

ReDim tmp(1 To d2)

For i = 1 To d2 Step 1

tmp(i) = (-1) * kol_post(i)

Next i

For i = 1 To d2 - 1

For j = i + 1 To d2

If tmp(i) > tmp(j) Then

temp = tmp(i)

tmp(i) = tmp(j)

tmp(j) = temp

End If

Next j

Next i

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

Worksheets("Лист1").Cells(i + 15, j + 8) = postavka(i, j)

Worksheets("Лист1").Cells(15, j + 8) = потр_пост(j)

Worksheets("Лист1").Cells(i + 15, 16) = потр_пост(i)

Next j

Next i

Dim x As Double

Dim y As Double

For i = 1 To 7 Step 1

For k = 1 To d2 Step 1

For j = 1 To 7 Step 1

If metka(i, j) = "-->" And Worksheets("Лист1").Cells(15, j + 8) <> 0 And Worksheets("Лист1").Cells(i + 15, 16) <> 0 Then

If Worksheets("Лист1").Cells(15, j + 8) = tmp(k) Then

y = Worksheets("Лист1").Cells(15, j + 8)

x = Worksheets("Лист1").Cells(i + 15, 16)

Worksheets("Лист1").Cells(i + 15, j + 8) = min(x, y)

tmp(k) = tmp(k) - min(x, y)

Worksheets("Лист1").Cells(15, j + 8) = y - min(x, y)

Worksheets("Лист1").Cells(i + 15, 16) = x - min(x, y)

End If

End If

Next j

Next k

Next i

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

postavka(i, j) = Worksheets("Лист1").Cells(i + 15, j + 8)

Next j

Next i

Loop While flag = False

Dim p(1 To 7) As Double

Dim m1(1 To 7) As String

Do

fl = False

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

postavka(i, j) = Worksheets("Лист1").Cells(i + 15, j + 8)

metka(i, j) = Worksheets("Лист1").Cells(i + 6, j + 8)

Next j

Next i

For i = 1 To 7 Step 1

m1(i) = "."

p(i) = 0

Next i

'рассчитываем потенциалы

Do

p(1) = 0: m1(1) = "*"

f = True

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

If metka(i, j) = "-->" Then

If m1(i) = "*" And m1(j) <> "*" Then p(j) = p(i) + n(j, i): m1(j) = "*"

If m1(j) = "*" And m1(i) <> "*" Then p(i) = p(j) - n(i, j): m1(i) = "*"

End If

Next j

Next i

For i = 1 To 7 Step 1

If m1(i) <> "*" Then f = False

Next i

'выводим на лист

For i = 1 To 7 Step 1

Worksheets("Лист1").Cells(15, i) = p(i)

Next i

Loop While f = False

'проверяем опорный план на оптимальность

Dim s(1 To 3) As Double

k = 1

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

If metka(i, j) <> "-->" And metka(j, i) <> "-->" And m(i, j) = 1 And k <= 3 And i < j Then

If сравниваем(p(i), p(j)) = True Then

s(k) = n(i, j) - (p(i) - p(j)): MsgBox "i=" & i & ", j=" & j & ", s=" & s(k) & ", k=" & k:   k = k + 1

End If

If сравниваем(p(i), p(j)) = False Then

s(k) = n(i, j) - (p(j) - p(i)): MsgBox "i=" & i & ", j=" & j & ", s=" & s(k) & ", k=" & k: k = k + 1

End If

End If

Next j

Next i

For i = 1 To 3 Step 1

Worksheets("Лист1").Cells(17, i) = s(i)

Next i

fl = False

For i = 1 To 3 Step 1

If s(i) < 0 Then fl = True: Exit For

Next i

Dim str As String

y = 0

str = "Результат: "

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

If Worksheets("Лист1").Cells(i + 6, j + 8) = "-->" Then

str = str & " из пункта "

str = str & i & " в пункт " & j

str = str & " следует поставить " & Worksheets("Лист1").Cells(i + 15, j + 8) & " единиц груза, "

End If

y = y + Worksheets("Лист1").Cells(i + 15, j + 8) * Worksheets("Лист1").Cells(i + 6, j + 15)

Next j

Next i

'ответ

If fl = False Then

MsgBox str & " затраты составят " & y & " ден.ед.": Exit Sub

End If

Dim metka2(1 To 7, 1 To 7) As String