If ComboBox10.Value = True Then If потр(i) = Val(ComboBox10.Text) And пост(j) = Val(ComboBox10.Text) Then ComboBox10.BackColor = &H404040
If ComboBox11.Value = True Then If потр(i) = Val(ComboBox11.Text) And пост(j) = Val(ComboBox11.Text) Then ComboBox11.BackColor = &H404040
If ComboBox12.Value = True Then If потр(i) = Val(ComboBox12.Text) And пост(j) = Val(ComboBox12.Text) Then ComboBox12.BackColor = &H404040
If ComboBox13.Value = True Then If потр(i) = Val(ComboBox13.Text) And пост(j) = Val(ComboBox13.Text) Then ComboBox13.BackColor = &H404040
If ComboBox14.Value = True Then If потр(i) = Val(ComboBox14.Text) And пост(j) = Val(ComboBox14.Text) Then ComboBox14.BackColor = &H404040
Next j
Next i
End If
If check3 = True Then MsgBox "Некорректный ввод данных", vbCritical, "Ошибка": Exit Sub
tarif(1) = TextBox13.Text
tarif(2) = TextBox8.Text
tarif(3) = TextBox9.Text
tarif(4) = TextBox10.Text
tarif(5) = TextBox15.Text
tarif(6) = TextBox14.Text
tarif(7) = TextBox11.Text
tarif(8) = TextBox12.Text
tarif(9) = TextBox16.Text
For i = 1 To 7 Step 1
Worksheets("Лист1").Cells(1, i) = потр_пост(i)
Next i
For i = 1 To k Step 1
Worksheets("Лист1").Cells(2, i) = потр(i)
Next i
For i = 1 To h Step 1
Worksheets("Лист1").Cells(4, i) = пост(i)
Next i
For i = 1 To k Step 1
Worksheets("Лист1").Cells(3, i) = kol_potr(i)
Next i
For i = 1 To h Step 1
Worksheets("Лист1").Cells(5, i) = kol_post(i)
Next i
d1 = k
d2 = h
'пути
m(1, 1) = 0: m(1, 2) = 0: m(1, 3) = 0: m(1, 4) = 1: m(1, 5) = 0: m(1, 6) = 0: m(1, 7) = 1
m(2, 1) = 0: m(2, 2) = 0: m(2, 3) = 0: m(2, 4) = 0: m(2, 5) = 1: m(2, 6) = 1: m(2, 7) = 1
m(3, 1) = 0: m(3, 2) = 0: m(3, 3) = 0: m(3, 4) = 0: m(3, 5) = 1: m(3, 6) = 1: m(3, 7) = 0
m(4, 1) = 1: m(4, 2) = 0: m(4, 3) = 0: m(4, 4) = 0: m(4, 5) = 1: m(4, 6) = 0: m(4, 7) = 0
m(5, 1) = 0: m(5, 2) = 1: m(5, 3) = 1: m(5, 4) = 1: m(5, 5) = 0: m(5, 6) = 0: m(5, 7) = 0
m(6, 1) = 0: m(6, 2) = 1: m(6, 3) = 1: m(6, 4) = 0: m(6, 5) = 0: m(6, 6) = 0: m(6, 7) = 1
m(7, 1) = 1: m(7, 2) = 1: m(7, 3) = 0: m(7, 4) = 0: m(7, 5) = 0: m(7, 6) = 1: m(7, 7) = 0
'матрица тарифов
n(1, 1) = 0: n(1, 2) = 0: n(1, 3) = 0: n(1, 4) = tarif(1): n(1, 5) = 0: n(1, 6) = 0: n(1, 7) = tarif(6)
n(2, 1) = 0: n(2, 2) = 0: n(2, 3) = 0: n(2, 4) = 0: n(2, 5) = tarif(7): n(2, 6) = tarif(8): n(2, 7) = tarif(9)
n(3, 1) = 0: n(3, 2) = 0: n(3, 3) = 0: n(3, 4) = 0: n(3, 5) = tarif(3): n(3, 6) = tarif(4): n(3, 7) = 0
n(4, 1) = tarif(1): n(4, 2) = 0: n(4, 3) = 0: n(4, 4) = 0: n(4, 5) = tarif(2): n(4, 6) = 0: n(4, 7) = 0
n(5, 1) = 0: n(5, 2) = tarif(7): n(5, 3) = tarif(3): n(5, 4) = tarif(2): n(5, 5) = 0: n(5, 6) = 0: n(5, 7) = 0
n(6, 1) = 0: n(6, 2) = tarif(8): n(6, 3) = tarif(4): n(6, 4) = 0: n(6, 5) = 0: n(6, 6) = 0: n(6, 7) = tarif(5)
n(7, 1) = tarif(6): n(7, 2) = tarif(9): n(7, 3) = 0: n(7, 4) = 0: n(7, 5) = 0: n(7, 6) = tarif(5): n(7, 7) = 0
For i = 1 To 7 Step 1
For j = 1 To 7 Step 1
Worksheets("Лист1").Cells(i + 6, j) = m(i, j)
Worksheets("Лист1").Cells(i + 6, j + 15) = n(i, j)
Next j
Next i
For i = 1 To 7 Step 1
For j = 1 To 7 Step 1
metka(i, j) = "."
Worksheets("Лист1").Cells(i + 6, j + 8) = metka(i, j)
Next j
Next i
'расстовляем стрелочки(опорный план)
Do
f1 = True
k = 1
For i = 1 To 7 Step 1
For j = 1 To 7 Step 1
If k <= 6 And m(i, j) = 1 And metka(i, j) <> "-->" Then
metka(i, j) = "-->": k = k + 1
Else
metka(i, j) = "."
End If
Worksheets("Лист1").Cells(i + 6, j + 8) = metka(i, j)
Next j
Next i
If контур1 = False And контур2 = False And контур3 = False And контур4 = False And контур5 = False And контур6 = False And контур7 = False Then
flag = True
End If
If контур1 = True Or контур2 = True Or контур3 = True Or контур4 = True Or контур5 = True Or контур6 = True Or контур7 = True Then
flag = False
End If
'матрицапоставок
Dim tmp() As Double
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.