Sub Task3() 'Declare const ""//Îáúÿâèì êîíñòàíòîé êàâû÷êè Const quote As String = """" Set Trips = Worksheets("Êòî åäåò") Set Dates = Worksheets("Êîìàíäèðîâêè") Dim Emploees_Array As New Dictionary ' Declare array of company//Îáúÿâèì ìàññèâû ñòðîêîâîãî òèïà äëÿ êîìïàíèé Dim Company_Array(2) 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) 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 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 For Each Worker In Emploees_Array Date_End = 1 For Each Number In Emploees_Array.Item(Worker) 'MsgBox (Number) For i = 2 To Dates.Cells(1, 1).CurrentRegion.Rows.Count ' Íåÿâíîå ïðåîáðàçîâàíèå òèïà (Cstr) If Dates.Cells(i, 1).Value = CStr(Number) Then If Date_End <> 1 Then If CDate(Dates.Cells(i, 2)) < CDate(Date_End) Then For j = 2 To Trips.Cells(1, 1).CurrentRegion.Rows.Count If (Trips.Cells(j, 1) = CStr(Number)) And (Trips.Cells(j, 2) = Worker) Then Trips.Range(Cells(j, 1), Cells(j, 2)).Interior.Color = RGB(255, 204, 204) End If Next End If Else Date_End = Dates.Cells(i, 2) + Day(Dates.Cells(i, 3) + 1) End If End If Next Next Next End Sub Sub Task4() End Sub Function AddListOfWorkers(Emploees_Array As Dictionary) ' Enter form sheets list og workers Enter1 = 2 Enter2 = 2 Enter3 = 2 Enter4 = 2 ' Design from sheets list of workers Worksheets("Âñå ñïåöèàëèñòû").Rows(1).Interior.Color = RGB(190, 203, 242) Worksheets("Âñå ñïåöèàëèñòû").Cells(1, 2).ColumnWidth = 20 Worksheets("Âñå ñïåöèàëèñòû").Cells(1, 3).ColumnWidth = 15 Worksheets("Âñå ñïåöèàëèñòû").Cells(1, 7).ColumnWidth = 20 Worksheets("Âñå ñïåöèàëèñòû").Cells(1, 8).ColumnWidth = 15 Worksheets("Âñå ñïåöèàëèñòû").Cells(1, 12).ColumnWidth = 20 Worksheets("Âñå ñïåöèàëèñòû").Cells(1, 13).ColumnWidth = 15 Worksheets("Âñå ñïåöèàëèñòû").Cells(1, 17).ColumnWidth = 20 Worksheets("Âñå ñïåöèàëèñòû").Cells(1, 18).ColumnWidth = 15 ' Add title from sheets list of workers Worksheets("Âñå ñïåöèàëèñòû").Cells(Enter1 - 1, 2) = "Ïåðåâîä÷èêè" Worksheets("Âñå ñïåöèàëèñòû").Cells(Enter1 - 1, 7) = "Èíæåíåðû" Worksheets("Âñå ñïåöèàëèñòû").Cells(Enter1 - 1, 12) = "Òåõíîëîãè" Worksheets("Âñå ñïåöèàëèñòû").Cells(Enter1 - 1, 17) = "Îñòàëüíûå" ' Form a list of employees for posts For i = 2 To Worksheets("Êòî åäåò").Cells(1, 1).CurrentRegion.Rows.Count If (Emploees_Array.Item(Worksheets("Êòî åäåò").Cells(i, 2).Value) Like "*ïåðåâîä÷èê*") Then Worksheets("Âñå ñïåöèàëèñòû").Cells(Enter1, 1) = Worksheets("Êòî åäåò").Cells(i, 1) Worksheets("Âñå ñïåöèàëèñòû").Cells(Enter1, 2) = Worksheets("Êòî åäåò").Cells(i, 2) Enter1 = Enter1 + 1 End If If (Emploees_Array.Item(Worksheets("Êòî åäåò").Cells(i, 2).Value) = "èíæåíåð") Then Worksheets("Âñå ñïåöèàëèñòû").Cells(Enter2, 6) = Worksheets("Êòî åäåò").Cells(i, 1) Worksheets("Âñå ñïåöèàëèñòû").Cells(Enter2, 7) = Worksheets("Êòî åäåò").Cells(i, 2) Enter2 = Enter2 + 1 End If If (Emploees_Array.Item(Worksheets("Êòî åäåò").Cells(i, 2).Value) = "òåõíîëîã") Then Worksheets("Âñå ñïåöèàëèñòû").Cells(Enter3, 11) = Worksheets("Êòî åäåò").Cells(i, 1) Worksheets("Âñå ñïåöèàëèñòû").Cells(Enter3, 12) = Worksheets("Êòî åäåò").Cells(i, 2) Enter3 = Enter3 + 1 End If If (Emploees_Array.Item(Worksheets("Êòî åäåò").Cells(i, 2).Value) = "ñòðîèòåëü") Or _ (Emploees_Array.Item(Worksheets("Êòî åäåò").Cells(i, 2).Value) = "íà÷àëüíèê ó÷àñòêà") Or _ (Emploees_Array.Item(Worksheets("Êòî åäåò").Cells(i, 2).Value) = "ïðîðàá") Then Worksheets("Âñå ñïåöèàëèñòû").Cells(Enter4, 16) = Worksheets("Êòî åäåò").Cells(i, 1) Worksheets("Âñå ñïåöèàëèñòû").Cells(Enter4, 17) = Worksheets("Êòî åäåò").Cells(i, 2) Enter4 = Enter4 + 1 End If Next i For i = 2 To Worksheets("Âñå ñïåöèàëèñòû").Cells(1, 1).CurrentRegion.Rows.Count For j = 2 To Worksheets("Êîìàíäèðîâêè").Cells(1, 1).CurrentRegion.Rows.Count If Worksheets("Êîìàíäèðîâêè").Cells(j, 1) = Worksheets("Âñå ñïåöèàëèñòû").Cells(i, 1) Then Worksheets("Âñå ñïåöèàëèñòû").Cells(i, 3) = Worksheets("Êîìàíäèðîâêè").Cells(j, 2).Value Worksheets("Âñå ñïåöèàëèñòû").Cells(i, 4) = Worksheets("Êîìàíäèðîâêè").Cells(j, 3) End If Next Next For i = 2 To Worksheets("Âñå ñïåöèàëèñòû").Cells(1, 6).CurrentRegion.Rows.Count For j = 2 To Worksheets("Êîìàíäèðîâêè").Cells(1, 1).CurrentRegion.Rows.Count If Worksheets("Êîìàíäèðîâêè").Cells(j, 1) = Worksheets("Âñå ñïåöèàëèñòû").Cells(i, 6) Then Worksheets("Âñå ñïåöèàëèñòû").Cells(i, 8) = Worksheets("Êîìàíäèðîâêè").Cells(j, 2).Value Worksheets("Âñå ñïåöèàëèñòû").Cells(i, 9) = Worksheets("Êîìàíäèðîâêè").Cells(j, 3) End If Next Next For i = 2 To Worksheets("Âñå ñïåöèàëèñòû").Cells(1, 11).CurrentRegion.Rows.Count For j = 2 To Worksheets("Êîìàíäèðîâêè").Cells(1, 1).CurrentRegion.Rows.Count If Worksheets("Êîìàíäèðîâêè").Cells(j, 1) = Worksheets("Âñå ñïåöèàëèñòû").Cells(i, 11) Then Worksheets("Âñå ñïåöèàëèñòû").Cells(i, 13) = Worksheets("Êîìàíäèðîâêè").Cells(j, 2).Value Worksheets("Âñå ñïåöèàëèñòû").Cells(i, 14) = Worksheets("Êîìàíäèðîâêè").Cells(j, 3) End If Next Next For i = 2 To Worksheets("Âñå ñïåöèàëèñòû").Cells(1, 16).CurrentRegion.Rows.Count For j = 2 To Worksheets("Êîìàíäèðîâêè").Cells(1, 1).CurrentRegion.Rows.Count If Worksheets("Êîìàíäèðîâêè").Cells(j, 1) = Worksheets("Âñå ñïåöèàëèñòû").Cells(i, 16) Then Worksheets("Âñå ñïåöèàëèñòû").Cells(i, 18) = Worksheets("Êîìàíäèðîâêè").Cells(j, 2).Value Worksheets("Âñå ñïåöèàëèñòû").Cells(i, 19) = Worksheets("Êîìàíäèðîâêè").Cells(j, 3) End If Next Next End Function