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 Worksheets("Лист1").Cells(k + 6, r + 8) = ".": Exit Sub
If min(l, l1) = l1 Then Worksheets("Лист1").Cells(k1 + 6, r1 + 8) = ".": Exit Sub
End If
If a > b Then
If min(l, l1) = l Then Worksheets("Лист1").Cells(r + 6, k + 8) = ".": Exit Sub
If min(l, l1) = l1 Then Worksheets("Лист1").Cells(r1 + 6, k1 + 8) = ".": Exit Sub
End If
End If
End Sub
Public Sub kontur3(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 5) As Double
Dim l As Double
Dim l1 As Double
Dim l2 As Double
Dim l3 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 = 5) Or (a = 5 And b = 2)) And p(2) <= p(5) Then z(1) = 5: z(2) = 3: z(3) = 6: z(4) = 7: z(5) = 2
If ((a = 2 And b = 5) Or (a = 5 And b = 2)) And p(2) > p(5) Then z(1) = 2: z(2) = 7: z(3) = 6: z(4) = 3: z(5) = 5
If ((a = 3 And b = 5) Or (a = 5 And b = 3)) And p(3) <= p(5) Then z(1) = 5: z(2) = 2: z(3) = 7: z(4) = 6: z(5) = 3
If ((a = 3 And b = 5) Or (a = 5 And b = 3)) And p(3) > p(5) Then z(1) = 3: z(2) = 6: z(3) = 7: z(4) = 2: z(5) = 5
If ((a = 3 And b = 6) Or (a = 6 And b = 3)) And p(3) <= p(6) Then z(1) = 6: z(2) = 7: z(3) = 2: z(4) = 5: z(5) = 3
If ((a = 3 And b = 6) Or (a = 6 And b = 3)) And p(3) > p(6) Then z(1) = 3: z(2) = 5: z(3) = 2: z(4) = 7: z(5) = 6
If ((a = 6 And b = 7) Or (a = 7 And b = 6)) And p(6) <= p(7) Then z(1) = 7: z(2) = 2: z(3) = 5: z(4) = 3: z(5) = 6
If ((a = 6 And b = 7) Or (a = 7 And b = 6)) And p(6) > p(7) Then z(1) = 6: z(2) = 3: z(3) = 5: z(4) = 2: z(5) = 7
If ((a = 2 And b = 7) Or (a = 7 And b = 2)) And p(2) <= p(7) Then z(1) = 7: z(2) = 6: z(3) = 3: z(4) = 5: z(5) = 2
If ((a = 2 And b = 7) Or (a = 7 And b = 2)) And p(2) > p(7) Then z(1) = 2: z(2) = 5: z(3) = 3: z(4) = 6: z(5) = 7
Worksheets("Лист3").Cells(min1(a, b) + 10, max1(a, b)) = "+"
s = 0
If p(a) <= p(b) And a <= b Then
If p(z(1)) - n(z(1), z(2)) = p(z(2)) Then Worksheets("Лист3").Cells(min(z(1), z(2)) + 10, max(z(1), z(2))) = "-": s = s + 1
If p(z(1)) + n(z(1), z(2)) = p(z(2)) Then Worksheets("Лист3").Cells(min(z(1), z(2)) + 10, max(z(1), z(2))) = "+"
If p(z(2)) - n(z(2), z(3)) = p(z(3)) Then Worksheets("Лист3").Cells(min(z(2), z(3)) + 10, max(z(2), z(3))) = "-": s = s + 1
If p(z(2)) + n(z(2), z(3)) = p(z(3)) Then Worksheets("Лист3").Cells(min(z(2), z(3)) + 10, max(z(2), z(3))) = "+"
If p(z(3)) - n(z(3), z(4)) = p(z(4)) Then Worksheets("Лист3").Cells(min(z(3), z(4)) + 10, max(z(3), z(4))) = "-": s = s + 1
If p(z(3)) + n(z(3), z(4)) = p(z(4)) Then Worksheets("Лист3").Cells(min(z(3), z(4)) + 10, max(z(3), z(4))) = "+"
If p(z(4)) - n(z(4), z(5)) = p(z(5)) Then Worksheets("Лист3").Cells(min(z(4), z(5)) + 10, max(z(4), z(5))) = "-": s = s + 1
If p(z(4)) + n(z(4), z(5)) = p(z(5)) Then Worksheets("Лист3").Cells(min(z(4), z(5)) + 10, max(z(4), z(5))) = "+"
End If
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.