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
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
' Declare sheets
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
' 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) = "Все специалисты"
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
List_Of_Trips.Cells(1, 2).ColumnWidth = 20
List_Of_Trips.Cells(1, 3).ColumnWidth = 25
For i = 2 To Trip_Row
engineer = 1
technologist = 1
more = 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) = "инженер") Then
engineer = engineer + 1
End If
If (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
more = more + 1
End If
End If
Next
If engineer = 1 And Trips.Cells(i, 4) = "Испытания" Then
List_Of_Trips.Cells(Enter, 2) = "Test"
List_Of_Trips.Cells(Enter, 2).Interior.Color = RGB(190, 203, 242)
Enter = Enter + 1
End If
If technologist = 1 And Trips.Cells(i, 4) = "Предварительное обследование" Then
List_Of_Trips.Cells(Enter, 2) = "Test111"
List_Of_Trips.Cells(Enter, 2).Interior.Color = RGB(242, 218, 133)
Enter = Enter + 1
End If
If more = 1 And Trips.Cells(i, 4) = "Строительство" Then
List_Of_Trips.Cells(Enter, 2) = "Алалалал"
List_Of_Trips.Cells(Enter, 2).Interior.Color = RGB(242, 158, 211)
Enter = Enter + 1
End If
Enter = Enter + 1
Next
End Sub
Function SheetExists(ShName As String) As Boolean
Dim Sh As Worksheet
' Initial conditions
SheetExists = False
For Each Sh In ActiveWorkbook.Sheets
If Sh.Name Like ShName Then
SheetExists = True
Set Sh = Nothing
Exit Function
End If
Next Sh
End Function