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
Sub Task2()
' Declare const ""
Const quote As String = """"
' Check availability sheet
Application.DisplayAlerts = False
If SheetExists("Ñîòðóäíèêè") Then
Sheets("Ñîòðóäíèêè").Delete
End If
Application.DisplayAlerts = True
' Declare sheets
Set Workers = Worksheets.Add
Workers.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(1) As String
' Add name of company in array
Company_Array(0) = "ÍÈÈ " & quote & "Ðàññâåò" & quote
Company_Array(1) = "ÇÀÎ " & quote & "Ñòðîèòåëü" & quote
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
For i = 2 To Trip_Row
For j = 2 To Employee_Row
If Trips.Cells(i, 1) = Employees.Cells(j, 1) Then
' Writes data to the Worker sheets
Workers.Cells(Enter, 1) = Employees.Cells(j, 1)
Workers.Cells(Enter, 2) = Employees.Cells(j, 2)
Enter = Enter + 1
End If
Next
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