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

w(i, j) = Worksheets("Лист3").Cells(i, j)

Next j

Next i

If s = 1 Then

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

If w(i, j) = "-" Then l = postavka(i, j): k = i: r = j: Exit For

Next j

Next i

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

If w(i, j) = "-" Then postavka(i, j) = postavka(i, j) - l

If w(i, j) = "+" Then postavka(i, j) = postavka(i, j) + l

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)

Next j

Next i

If a <= b Then

metka(k, r) = "."

End If

If a > b Then

metka(r, k) = "."

End If

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

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

Next j

Next i

End If

If s = 2 Then

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

If w(i, j) = "-" Then l = postavka(i, j): k = i: r = j: Exit For

Next j

Next i

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

If w(i, j) = "-" And i <> k And j <> r Then l1 = postavka(i, j): k1 = i: r1 = j: Exit For

Next j

Next i

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

If w(i, j) = "-" Then postavka(i, j) = postavka(i, j) - min(l, l1)

If w(i, j) = "+" Then postavka(i, j) = postavka(i, j) + min(l, l1)

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)

Next j

Next i

If a <= b Then

If min(l, l1) = l Then metka(k, r) = "."

If min(l, l1) = l1 Then metka(k1, r1) = "."

End If

If a > b Then

If min(l, l1) = l Then metka(r, k) = "."

If min(l, l1) = l1 Then metka(r1, k1) = "."

End If

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

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

Next j

Next i

End If

If s = 3 Then

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

If w(i, j) = "-" Then l = postavka(i, j): k = i: r = j: Exit For

Next j

Next i

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

If w(i, j) = "-" And i <> k And j <> r Then l1 = postavka(i, j): k1 = i: r1 = j: Exit For

Next j

Next i

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

If w(i, j) = "-" And i <> k And j <> r And i <> k1 And j <> r1 Then l2 = postavka(i, j): k2 = i: r2 = j: Exit For

Next j

Next i

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

If w(i, j) = "-" Then postavka(i, j) = postavka(i, j) - min(l, min(l1, l2))

If w(i, j) = "+" Then postavka(i, j) = postavka(i, j) + min(l, min(l1, l2))

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)

Next j

Next i

If a <= b Then

If min(l, min(l1, l2)) = l Then metka(k, r) = "."

If min(l, min(l1, l2)) = l1 Then metka(k1, r1) = "."

If min(l, min(l1, l2)) = l2 Then metka(k1, r1) = "."

End If

If a > b Then

If min(l, min(l1, l2)) = l Then metka(r, k) = "."

If min(l, min(l1, l2)) = l1 Then metka(r1, k1) = "."

If min(l, min(l1, l2)) = l2 Then metka(r1, k1) = "."

End If

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

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

Next j

Next i

End If

End Sub

Public Sub kontur2(a As Integer, b As Integer)

Dim p(1 To 7) As Double

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

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

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

Dim z(1 To 3) As Double

Dim l As Double

Dim l1 As Double

For i = 1 To 7 Step 1

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

Next i

For i = 1 To 7 Step 1

For j = 1 To 7 Step 1

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

Next j

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

If ((a = 2 And b = 6) Or (a = 6 And b = 2)) And p(2) <= p(6) Then z(1) = 6: z(2) = 7: z(3) = 2