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