Sub z3_b Dim CurValue lastrow lastrow1 As Integer Dim d1 d2 d3 d4 As D

 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
Sub z3_b()
Dim i, j, CurValue, lastrow, lastrow1, k, n, x As Integer
Dim d1, d2, d3, d4 As Date
Dim Name As String
Dim engeneer, engeneerFound As Boolean
Dim page1, page2 As Object
Set page1 = Worksheets("Êòî åäåò")
Set page2 = Worksheets("Ñïèñîê èíæåíåðîâ")
engeneer = False
engeneerFound = False
lastrow = page1.Cells(1, 1).CurrentRegion.Rows.Count
lastrow1 = page2.Cells(1, 1).CurrentRegion.Rows.Count
i = 2
While (i < lastrow)
engeneer = False
CurValue = Cells(i, 1).Value
If Cells(i, 7).Value = "Èñïûòàíèÿ" Then
j = i
Do While Cells(j, 1) = CurValue
If Cells(j, 3).Value Like "*èíæåíåð*" Then
engeneer = True
Exit Do
End If
j = j + 1
Loop
If Not engeneer Then
'èùåì èíæåíåðà, êîòîðûé ïðè ýòîì ñâîáîäåí äëÿ äàííîé êîìàíäèðîâêè (ò.å. ïåðèîäû âñåõ åãî êîìàíäèðîâîê íå ïåðåñåêàþòñÿ ñ äàííîé)
d1 = page1.Cells(j - 1, 4)
d2 = DateAdd("d", d1, page1.Cells(j - 1, 5))
For k = 2 To lastrow1 - 1
d3 = page2.Cells(k, 4)
d4 = DateAdd("d", d3, page2.Cells(k, 5))
If ((d2 < d3) Or (d1 > d4)) Then
For x = k + 1 To lastrow1
If page1.Cells(x, 2) = page1.Cells(k, 2) Then
d3 = page2.Cells(x, 4)
d4 = DateAdd("d", d3, page2.Cells(x, 5))
If (Not ((d2 < d3) Or (d1 > d4))) Then
Exit For
End If
End If
Next x
If x = lastrow1 Then
n = k
engeneerFound = True
Exit For
End If
End If
Next k
If engeneerFound = True Then
page1.Range(page1.Cells(j, 1), page1.Cells(lastrow, 7)).Copy
page1.Range(page1.Cells(j + 1, 1), page1.Cells(lastrow + 1, 7)).PasteSpecial
page2.Rows(n).Copy
page1.Rows(j).PasteSpecial
Cells(j, 1) = CurValue
Cells(j, 4) = Cells(j - 1, 4)
Cells(j, 5) = Cells(j - 1, 5)
Cells(j, 7) = Cells(j - 1, 7)
Rows(j).Interior.ColorIndex = 50
lastrow = lastrow + 1
End If
End If
End If
Do While Cells(i, 1) = CurValue
i = i + 1
Loop
Wend
End Sub