Option Explicit  
Private Sub Gant()  
Dim i As Long  
Dim FIO As String  
Dim KolFIO As Long  
Dim FoundFIO As Range  
Dim iBegin As Date  
Dim iEnd As Date  
Dim FoundBegin As Range  
Dim FoundEnd As Range  
 
With Sheets("Лист1")  
   KolFIO = 0  
   While .Cells(KolFIO + 18, 2).Value <> ""  
       KolFIO = KolFIO + 1  
   Wend  
       Rows("4:9").EntireRow.Interior.ColorIndex = xlColorIndexNone  
   For i = 1 To KolFIO  
      FIO = .Cells(17 + i, 2)  
   iBegin = .Cells(17 + i, 3)  
     iEnd = .Cells(17 + i, 4)  
       
     Set FoundFIO = .Range("B4:B9").Find(FIO, , xlValues, xlWhole)  
     Set FoundBegin = .Rows(3).Find(iBegin, , xlFormulas, xlWhole)  
     Set FoundEnd = .Rows(3).Find(iEnd, , xlValues, xlWhole)  
.Range(.Cells(FoundFIO.Row, FoundBegin.Column), .Cells(FoundFIO.Row, FoundEnd.Column)). _  
Interior.ColorIndex = 3  
   Next  
End With  
End Sub