Sub z_3 Dim CurValue lastrow lastrow1 As Integer Dim d1 d2 d3 d4 As Da

 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
Sub z_3()
Dim i, j, CurValue, lastrow, lastrow1, k, n As Integer
Dim d1, d2, d3, d4 As Date
Dim perevodchik As Boolean
perevodchik = False
lastrow = Worksheets("Кто едет").Cells(1, 1).CurrentRegion.Rows.Count
lastrow1 = Worksheets("Список переводчиков").Cells(1, 1).CurrentRegion.Rows.Count
i = 2
While (i <> lastrow And i < lastrow)
perevodchik = False
CurValue = Cells(i, 1).Value
j = i
Do While Cells(j, 1) = CurValue
If Cells(j, 3) Like "*переводчик*" Then 'косяк
perevodchik = True
Exit Do
End If
j = j + 1
Loop
If Not perevodchik Then
'ищем переводчика, который при этом свободен для данной командировки (т.е. периоды всех его командировок не пересекаются с данной)
For k = 2 To lastrow1
d1 = Sheets("Кто едет").Cells(j - 1, 4)
d2 = Sheets("Кто едет").Cells(j - 1, 5)
d3 = Sheets("Список переводчиков").Cells(k, 4)
d4 = Sheets("Список переводчиков").Cells(k, 5)
If ((d1 < d3) And (d2 < d3)) Or ((d1 > d3) And (d1 > d4)) Then
n = k
Exit For
End If
Next k
Sheets("Кто едет").Range(Sheets("Кто едет").Cells(j, 1), Sheets("Кто едет").Cells(lastrow, 6)).Copy
Sheets("Кто едет").Range(Sheets("Кто едет").Cells(j + 1, 1), Sheets("Кто едет").Cells(lastrow + 1, 6)).PasteSpecial
Sheets("Список переводчиков").Rows(n).Copy
Sheets("Кто едет").Rows(j).PasteSpecial
Cells(j, 1) = CurValue
Cells(j, 4) = Cells(j - 1, 4)
Cells(j, 5) = Cells(j - 1, 5)
Cells(j, 6) = "заграничная"
lastrow = lastrow + 1
End if
End If
Do While Cells(j, 1) = CurValue
i = i + 1
Loop
Wend
End Sub