1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
| Sub АлгоритмДжонсона()
'Курсовая работа по "Математическим методам"
'Группа 31-П
'Студентка Комарова К.С.
Dim N As Integer, M As Byte, i As Integer, j As Byte
Dim Y(100) As Single, Z(100) As Integer
Dim A(1 To 100, 1 To 100) As Single
Dim min As Single, min1 As Single, min3 As Single, max As Single
Dim f As Integer, g As Byte, p As Integer
Dim C(1 To 100, 1 To 100) As Single, W As Boolean
Dim B(1 To 100, 1 To 100) As Single, e As Integer, o As Byte
MsgBox " Программа применяется для решения задач " & _
"об упорядочевании " & Chr(10) & _
"c 2-я обслуживающими устройствами" & _
" по алгоритму Джонсона.", vbInformation, "На заметку"
N = InputBox("Введите количество обрабатываемых деталей.", "Детали")
M = InputBox("Введите количество станков.", "Станки")
For i = 1 To N
Y(i) = i
Next i
For j = 1 To M
Z(j) = j
Next j
For i = 1 To N
For j = 1 To M
A(i, j) = InputBox(" Введите затраты времени на обработку " & _
Chr(10) & "детали № " & Y(i) & _
" на станке № " & Z(j), "Затраты")
Next j
Next i
Cells(1, 1) = "Затраты времени на обработку деталей"
Cells(2, 1) = "№детали/№станка"
For i = 1 To N
Cells(i + 2, 1) = Y(i)
Next i
For j = 1 To M
Cells(2, j + 1) = Z(j)
Next j
For i = 1 To N
For j = 1 To M
Cells(i + 2, j + 1) = A(i, j)
Next j
Next i
W = False
If M = 3 Then
min1 = A(1, 1)
For i = 2 To N
If min1 >= A(i, 1) Then min1 = A(i, 1)
Next i
max2 = A(1, 2)
For i = 2 To N
If max2 <= A(i, 2) Then max2 = A(i, 2)
Next i
min3 = A(1, 3)
For i = 2 To N
If min3 >= A(i, 3) Then min3 = A(i, 3)
Next i
If (min1 >= max2) Or (min3 >= max2) Then
For i = 1 To N
B(i, 1) = A(i, 1) + A(i, 2)
B(i, 2) = A(i, 2) + A(i, 3)
Next i
W = True
Else
MsgBox " Условие задачи не отвечает требованием" & Chr(10) _
& " алгоритма Джонсона для 3-х " & _
"обслуживающих устройств.", vbExcalamation, "Внимание!"
End If
ElseIf M = 2 Then
W = True
For i = 1 To N
B(i, 1) = A(i, 1)
B(i, 2) = A(i, 2)
Next i
End If
If W = True Then
f = 1: g = 1: min = B(1, 1)
e = 1: o = N
For p = 1 To N
For j = 1 To 2
For i = 1 To N
If (B(i, j) <= min) And (B(i, j) >= 0) Then
If min = B(i, j) Then
If j = 1 Then
If B(f, 2) > B(i, 2) Then
min = B(i, j): f = i: g = j
ElseIf B(f, 2) < 0 Then
min = B(i, j): f = i: g = j
End If
Else
If B(f, 1) > B(i, 1) Then
min = B(i, j): f = i: g = j
ElseIf B(f, 1) < 0 Then
min = B(i, j): f = i: g = j
End If
End If
Else
min = B(i, j): f = i: g = j
End If
End If
Next i
Next j
If g = 1 Then
If M = 3 Then
C(e, 1) = Y(f): C(e, 2) = A(f, 1)
C(e, 3) = A(f, 2): C(e, 4) = A(f, 3)
Else
C(e, 1) = Y(f): C(e, 2) = A(f, 1): C(e, 3) = A(f, 2)
End If
e = e + 1
Else
If M = 3 Then
C(o, 1) = Y(f): C(o, 2) = A(f, 1)
C(o, 3) = A(f, 2): C(o, 4) = A(f, 3)
Else
C(o, 1) = Y(f): C(o, 2) = A(f, 1): C(o, 3) = A(f, 2)
End If
o = o - 1
End If
B(f, 1) = -1: B(f, 2) = -1: min = 10000
Next p
Cells(N + 4, 1) = "Оптимальная последовательность обработки деталей"
Cells(N + 5, 1) = "№детали/№станка"
For j = 1 To M
Cells(N + 5, 1 + j) = Z(j)
Next j
p = N + 6
For i = 1 To N
For j = 1 To M + 1
Cells(p, j) = C(i, j)
Next j
p = p + 1
Next i
Else
MsgBox " Решение задачи с помощью данной программы" & Chr(10) & _
" по алгоритму Джонсона не может быть получено" & _
Chr(10) & " из-за несоответствия данных условиям алгоритма" _
, vbExcalamation, "Внимание!"
End If
End Sub |