Sub Task2 Declare const Const quote As String Check availability sheet

  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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
Sub Task2()
' Declare const ""
Const quote As String = """"
' Check availability sheet
Application.DisplayAlerts = False
If SheetExists("Все командировки") Then
Sheets("Все командировки").Delete
End If
If SheetExists("Все специалисты") Then
Sheets("Все специалисты").Delete
End If
Application.DisplayAlerts = True
Set List_Of_Workers = Worksheets.Add
List_Of_Workers.Name = "Все специалисты"
Set List_Of_Trips = Worksheets.Add
List_Of_Trips.Name = "Все командировки"
Set Trips = Worksheets("Командировки")
Set Employees = Worksheets("Кто едет")
' Declare variables for lengths
Dim Employee_Row, Trip_Row As Integer
Dim Emploees_Array As New Dictionary
Dim Country_Array As New Dictionary
' Declare array of company
Dim Company_Array(2) As String
' Add name of company in array
Company_Array(0) = "НИИ " & quote & "Рассвет" & quote
Company_Array(1) = "ЗАО " & quote & "Строитель" & quote
Company_Array(2) = "Приглашенные специалисты"
' Fulling country array
For i = 2 To Worksheets("Список городов вне").Cells(1, 1).CurrentRegion.Rows.Count
Country_Array.Add Worksheets("Список городов вне").Cells(i, 1).Value, Worksheets("Список городов вне").Cells(i, 1).Value
Next
' Fulling company array
For Each test In Company_Array
For i = 2 To Worksheets(test).Cells(2, 1).CurrentRegion.Rows.Count
Emploees_Array.Add Worksheets(test).Cells(i, 1).Value, Worksheets(test).Cells(i, 4).Value
Next
Next
' Gets the length of sheets
Trip_Row = Trips.Cells(2, 1).CurrentRegion.Rows.Count
Employee_Row = Employees.Cells(2, 1).CurrentRegion.Rows.Count
' It's enter in Workers List
Enter = 2
' Create worker list
a = AddListOfWorkers(Emploees_Array)
' Design from sheets list list of trips
List_Of_Trips.Cells(1, 2).ColumnWidth = 20
List_Of_Trips.Cells(1, 3).ColumnWidth = 25
For i = 2 To Trip_Row
' Col emploeer in list
Translator = 1
Engineer = 1
Technologist = 1
Others = 1
For j = 2 To Employee_Row
If Trips.Cells(i, 1) = Employees.Cells(j, 1) Then
' Writes data to the Worker sheets
List_Of_Trips.Cells(Enter, 1) = Employees.Cells(j, 1)
List_Of_Trips.Cells(Enter, 2) = Employees.Cells(j, 2)
List_Of_Trips.Cells(Enter, 3) = Emploees_Array.Item(Employees.Cells(j, 2).Value)
Enter = Enter + 1
If (Emploees_Array.Item(Employees.Cells(j, 2).Value) Like "*переводчик*") Then
Translator = Translator + 1
End If
If (Emploees_Array.Item(Employees.Cells(j, 2).Value) = "инженер") Then
Engineer = Engineer + 1
End If
If (Emploees_Array.Item(Employees.Cells(j, 2).Value) = "технолог") Or _
(Emploees_Array.Item(Employees.Cells(j, 2).Value) = "строитель") Then
Technologist = Technologist + 1
End If
If (Emploees_Array.Item(Employees.Cells(j, 2).Value) = "строитель") Or _
(Emploees_Array.Item(Employees.Cells(j, 2).Value) = "начальник участка") Or _
(Emploees_Array.Item(Employees.Cells(j, 2).Value) = "прораб") Then
Others = Others + 1
End If
End If
Next
' Last date of trip
Date_Finish = Trips.Cells(i, 2) + Day(Trips.Cells(i, 3) + 1)
' Insert the translator
If Translator = 1 And Country_Array.Item(Trips.Cells(i, 5).Value) <> 0 Then
' Choosing a translator
For k = 2 To List_Of_Workers.Cells(1, 1).CurrentRegion.Rows.Count
' Check the timing
If CDate(Date_Finish) < CDate(List_Of_Workers.Cells(k, 3)) And List_Of_Workers.Cells(k, 5) = "" Then
List_Of_Trips.Cells(Enter, 1) = List_Of_Workers.Cells(k, 1)
List_Of_Trips.Cells(Enter, 2) = List_Of_Workers.Cells(k, 2)
List_Of_Trips.Cells(Enter, 3) = Emploees_Array.Item(List_Of_Workers.Cells(k, 2).Value)
List_Of_Workers.Cells(k, 5) = "Был"
Exit For
End If
Next
List_Of_Trips.Range(Cells(Enter, 1), Cells(Enter, 3)).Interior.Color = RGB(255, 160, 209)
Enter = Enter + 1
End If
' Insert the engineer
If Engineer = 1 And Trips.Cells(i, 4) = "Испытания" Then
' Choosing a engineer
For k = 2 To List_Of_Workers.Cells(1, 1).CurrentRegion.Rows.Count
' Check the timing
If CDate(Date_Finish) < CDate(List_Of_Workers.Cells(k, 8)) And List_Of_Workers.Cells(k, 10) = "" Then
List_Of_Trips.Cells(Enter, 1) = List_Of_Workers.Cells(k, 6)
List_Of_Trips.Cells(Enter, 2) = List_Of_Workers.Cells(k, 7)
List_Of_Trips.Cells(Enter, 3) = Emploees_Array.Item(List_Of_Workers.Cells(k, 7).Value)
List_Of_Workers.Cells(k, 10) = "Был"
Exit For
End If
Next
List_Of_Trips.Range(Cells(Enter, 1), Cells(Enter, 3)).Interior.Color = RGB(255, 210, 205)
Enter = Enter + 1
End If
' Insert the technologist
If Technologist = 1 And Trips.Cells(i, 4) = "Предварительное обследование" Then
' Choosing a technologist
For k = 2 To List_Of_Workers.Cells(1, 1).CurrentRegion.Rows.Count
' Check the timing
If CDate(Date_Finish) < CDate(List_Of_Workers.Cells(k, 13)) And List_Of_Workers.Cells(k, 15) = "" Then
List_Of_Trips.Cells(Enter, 1) = List_Of_Workers.Cells(k, 11)
List_Of_Trips.Cells(Enter, 2) = List_Of_Workers.Cells(k, 12)
List_Of_Trips.Cells(Enter, 3) = Emploees_Array.Item(List_Of_Workers.Cells(k, 12).Value)
List_Of_Workers.Cells(k, 15) = "Был"
Exit For
End If
Next
List_Of_Trips.Range(Cells(Enter, 1), Cells(Enter, 3)).Interior.Color = RGB(236, 193, 255)
Enter = Enter + 1
End If
' Insert the other
If Others = 1 And Trips.Cells(i, 4) = "Строительство" Then
' Choosing a other
For k = 2 To List_Of_Workers.Cells(1, 1).CurrentRegion.Rows.Count
' Check the timing
If CDate(Date_Finish) < CDate(List_Of_Workers.Cells(k, 18)) And List_Of_Workers.Cells(k, 20) = "" Then
List_Of_Trips.Cells(Enter, 1) = List_Of_Workers.Cells(k, 16)
List_Of_Trips.Cells(Enter, 2) = List_Of_Workers.Cells(k, 17)
List_Of_Trips.Cells(Enter, 3) = Emploees_Array.Item(List_Of_Workers.Cells(k, 17).Value)
List_Of_Workers.Cells(k, 20) = "Был"
Exit For
End If
Next
List_Of_Trips.Range(Cells(Enter, 1), Cells(Enter, 3)).Interior.Color = RGB(255, 191, 113)
Enter = Enter + 1
End If
' Color border bottom
List_Of_Trips.Cells(Enter, 1).EntireRow.Borders(xlEdgeTop).Weight = xlThick
Next
End Sub