CStr (Worksheets (1). Cells (i + 3, 4). Value)
Time1 = CStr (Worksheets (1). Cells (i + 3, 5). Value)
Aud1 = CStr (Worksheets (1). Cells (i + 3, 8). Value)
indicator = 0
If Time1 = Vrem And Day1 = Den And aud = Aud1 Then
For j = CInt (L1.Text) To CInt (L2.Text)
If Worksheets (1). Cells (i + 3, 11 + j). Value = "*" Then
'indicator = 1
ColZ = ColZ + 1
mZ (ColZ) = i + 3
Exit For
End If
Next
End If
Next
Cells (NumStr, NumCol). Select
With Selection.Interior
. ColorIndex = 38
. Pattern = xlSolid
End With
End Sub
Private Sub Com_3_Click ()
row7 = ActiveCell.Row 'Обчислення номера стовпчика і рядка
col7 = ActiveCell.Column
Symma = Cells (NumStr, NumCol). Value 'Підсумкова сума копируемой осередку
N = 0 'Обчислення числа рядків на першому аркуші
While Worksheets (1). Cells (N + 4, 1). Value <> "" p> N = N + 1
Wend
NNa = 0 'Кількість аудиторій на першому аркуші
While Worksheets (2). Cells (NNa + 2, 1). Value <> "" p> NNa = NNa + 1
Wend
audN = CStr (Cells (row7, 1)) 'Значення аудиторії, дня і часу виділеної
denN = CStr (Cells (5, col7)) 'осередку
vremZ = CStr (Cells (6, col7))
flagZ = 0 'Індикатор можливості переміщення заявок
For i = 4 To N + 3 'Перевірка занять
For j = +1 To ColZ
If i = mZ (j) Then
GoTo Nexti2 'Обходимо копійований заявку
End If
Next
a_i = CStr (Worksheets (1). Cells (i, 8). Value)
d_i = CStr (Worksheets (1). Cells (i, 4). Value)
v_i = CStr (Worksheets (1). Cells (i, 5). Value)
o_i = CStr (Worksheets (1). Cells (i, 7). Value)
If o_i <> "так" Then 'Якщо заявка необслужена, то її обходимо
GoTo Nexti2
End If
For j = 1 To ColZ 'Цикл за кількістю переміщуються заявок
If audN = a_i And denN = d_i And vremZ = v_i Then
'При збігу аудиторії, дня і часу
For m = 0 To 17
If Worksheets (1). Cells (i, 11 + m). Value = "*" _
And Worksheets (1). Cells (mZ (j), 11 + m). Value = "*" Then
flagZ = 1 'Якщо є перекриття хоча б по одному тижні,
Exit For 'то копіювання неможливо
End If
Next 'Цикл по тижнях
End If
If flagZ = 1 Then
Exit For
End If
Next 'Цикл за кількістю переміщуються заявок
If flagZ = 1 Then
Exit For
End If
Nexti2: Next 'Завершення перевірки
If flagZ = 1 Then 'Якщо копіювання неможливо, то виводимо відповідне повідомлення
MsgBox ("Заявку вдається перенести. Аудиторне час зайнято.")
Max1 = CInt (L2.Text) - CInt (L1.Text) + 1
porog1 = CInt (Max1/2)
row7 = NumStr
col7 = NumCol
a = CInt (Cells (row7, col7). Value)
If a = 0 Then
ElseIf a = Max1 Then
Cells (row7, col7). Select
With Selection.Interior
. ColorIndex = 7
. Pattern = xlSolid
End With
ElseIf a <= porog1 Then
Cells (row7, col7). Select
With Selection.Interior
. ColorIndex = 8
. Pattern = xlSolid
End With
ElseIf a> porog1 And a
Cells (row7, col7). Select
With Selection.Interior
. ColorIndex = 15
. Pattern = xlSolid
End With
End If
Exit Sub
End If
'Цикл за кількістю копіювали заявок
Worksheets (1). Unprotect
For ia = 1 To ColZ
Nom = 0
While Worksheets (1). Cells (Nom + 4, 1). Value <> ""
Nom = Nom + 1
Wend
Worksheets (1). Cells (Nom + 4, 1). Value = Worksheets (1). Cells (mZ (ia), 1). Value
Worksheets (1). Cells (Nom + 4, 2). Value = Worksheets (1). Cells (mZ (ia), 2). Value
Worksheets (1). Cells (Nom + 4, 3). Value = Worksheets (1). Cells (mZ (ia), 3). Value
Worksheets (1). Cells (Nom + 4, 4). Value = denN
Worksheets (1). Cells (Nom + 4, 5). Value = vremZ
Worksheets (1). Cells (Nom + 4, 6). Value = Worksheets (1). Cells (mZ (ia), 6). Value
Worksheets (1). Cells (Nom + 4, 7). Value = Worksheets (1). Cells (mZ (ia), 7). Value
Worksheets (1). Cells (Nom + 4, 8). Value = audN
For uo = 9 To 28
Worksheets (1). Cells (Nom + 4, uo). Value = Worksheets (1). Cells (mZ (ia), uo). Value
Next
Next
'Завершення циклу по кількості копіював заявок
'Вилучення заявок
For oi = ColZ To 1 Step -1
i = mZ (oi)
Worksheets (1). Rows (i). Delete
Next
Worksheets (1). Protect DrawingObjects: = True, Contents: = True, ...
