Sub сроки()
    
    ' Declare const ""
    Const quote As String = """"
    
    ' Kto edet>>
    Set Trips = Worksheets("Кто едет")
    ' Komandirovky>>
    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
    
    
    For Each Worker In Emploees_Array
        Enter = 0
        For i = 2 To Trips.Cells(1, 1).CurrentRegion.Rows.Count
            If Worker = Trips.Cells(i, 2) Then
                Enter = Enter + 1
            End If
        Next
        
        ReDim Trips_Array(Enter)
        
        Key = 0
        
        For i = 2 To Trips.Cells(1, 1).CurrentRegion.Rows.Count
            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.Rows(j).Interior.Color = RGB(255, 204, 204)
                                End If
                            Next
                        Else
                            Date_End = Dates.Cells(i, 2) + Day(Dates.Cells(i, 3) + 1)
                        End If
                                
                    Else
                        Date_End = Dates.Cells(i, 2) + Day(Dates.Cells(i, 3) + 1)
                    End If
                End If
            Next
        Next
    Next
    
End Sub