Sub Task4 Declare const Const quote As String Application DisplayAlert

  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
Sub Task4()
' Declare const ""
Const quote As String = """"
Application.DisplayAlerts = False
If SheetExists("Командированные") Then
Sheets("Командированные").Delete
End If
Application.DisplayAlerts = True
' Declare sheets
Set Tripers = Worksheets.Add
Tripers.Name = "Командированные"
Set Trips = Worksheets("Кто едет")
Set Dates = Worksheets("Командировки")
Dim Emploees_Array As New Dictionary
Dim Emploees_Post As New Dictionary
' Declare array of company
Dim Company_Array(2) As String
Dim Trips_Info(3) As String
Dim Trips_Array() 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, 1)
Emploees_Post.Add Worksheets(test).Cells(i, 1).Value, Worksheets(test).Cells(i, 4)
Next
Next
' Remove dublicates to Trips sheets
nCol_Trip = Trips.Cells(1, 1).CurrentRegion.Columns.Count
nRow_Trip = Trips.Cells(1, 1).CurrentRegion.Rows.Count
Trips.Range(Trips.Cells(1, 1), Trips.Cells(nRow_Trip, nCol_Trip)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
For Each Worker In Emploees_Array
Enter = 0
For i = 2 To nRow_Trip
If Worker = Trips.Cells(i, 2) Then
Enter = Enter + 1
End If
Next
ReDim Trips_Array(Enter)
Key = 0
For i = 2 To nRow_Trip
If Worker = Trips.Cells(i, 2) Then
Trips_Array(Key) = Trips.Cells(i, 1)
Key = Key + 1
End If
Next
Emploees_Array.Item(Worker) = Trips_Array
Next
Tripers.Cells(1, 1) = "Номер командировки"
Tripers.Cells(1, 2) = "Фамилия специалист"
Tripers.Cells(1, 3) = "Должность"
Tripers.Cells(1, 4) = "Начало командировки"
Tripers.Cells(1, 5) = "Конец командировки"
Tripers.Cells(1, 6) = "Кол. дней в команд.."
Tripers.Cells(1, 7) = "Цель командировки"
Tripers.Cells(1, 8) = "Количество командировок"
Tripers.Cells(1, 9) = "Ед."
Tripers.Rows(1).Interior.Color = RGB(205, 195, 255)
Tripers.Rows(1).RowHeight = 25
Enter1 = 2
Tripers.Cells(Enter1, 1).EntireRow.Borders(xlEdgeTop).Weight = xlThick
For Each Worker In Emploees_Array
Col_Trip = 0
'Tripers.Cells(Enter1, 1) = Worker
For Each Number In Emploees_Array.Item(Worker)
For i = 2 To Dates.Cells(1, 1).CurrentRegion.Rows.Count
If CStr(Number) = CStr(Dates.Cells(i, 1)) Then
Trips_Info(0) = Dates.Cells(i, 2)
Trips_Info(1) = Dates.Cells(i, 2) + Day(Dates.Cells(i, 3) + 1)
Trips_Info(2) = Dates.Cells(i, 3)
Trips_Info(3) = Dates.Cells(i, 4)
End If
Next
If Number <> "" Then
Tripers.Cells(Enter1, 7) = Trips_Info(3)
Tripers.Cells(Enter1, 6) = Trips_Info(2)
Tripers.Cells(Enter1, 5) = Trips_Info(1)
Tripers.Cells(Enter1, 4) = Trips_Info(0)
Tripers.Cells(Enter1, 3) = Emploees_Post.Item(Worker)
Tripers.Cells(Enter1, 2) = Worker
Tripers.Cells(Enter1, 1) = Number
Enter1 = Enter1 + 1
Col_Trip = Col_Trip + 1
End If
Next
If Col_Trip <> 0 Then
Tripers.Cells(Enter1 - Col_Trip, 8) = "Количество командировок: "
Tripers.Cells(Enter1 - Col_Trip, 9) = Col_Trip
Tripers.Range(Cells(Enter1 - Col_Trip, 8), Cells(Enter1 - Col_Trip, 9)).Interior.Color = RGB(255, 198, 105)
' Color border bottom
Tripers.Cells(Enter1, 1).EntireRow.Borders(xlEdgeTop).Weight = xlThick
End If
Next
nRow_Tripers = Tripers.Cells(1, 1).CurrentRegion.Rows.Count
nCol_Tripers = Tripers.Cells(1, 1).CurrentRegion.Columns.Count
' Autosize sheets
Tripers.Range(Tripers.Cells(1, 1), Tripers.Cells(nRow_Tripers, nCol_Tripers)).EntireColumn.AutoFit
End Sub