Dim cend As Integer     '最終行
Dim hisu As Integer     '最終列

Sub ki094()
Dim i As Integer     '行
Dim j As Integer     '列
Application.ScreenUpdating = False
Sheets("Sheet1").Select
'最終セル
      ActiveCell.SpecialCells(xlLastCell).Select
      cend = ActiveCell.Row
      hisu = ActiveCell.Column
'前の色を消す
       ki094a
'色付け
For i = 3 To cend
     kan = 0
     If Cells(i, 3) = "" Then
        GoTo pasc
     End If
    For j = 8 To hisu
'出願期間
       hiz = Cells(i, j)
       If Cells(i, 3) <= hiz Then
           If hiz <= Cells(i, 4) Then
                Cells(i, j).Interior.ColorIndex = 5
                GoTo colorok
           End If
       End If
'試験日
      If Cells(i, 5) = hiz Then
           Cells(i, j).Interior.ColorIndex = 3
           GoTo colorok
       End If

'手続き期間
       If Cells(i, 6) <= hiz Then
           If hiz <= Cells(i, 7) Then
                Cells(i, j).Interior.ColorIndex = 6
                kan = 1
                GoTo colorok
           Else
               If kan = 1 Then
                   Exit For
               End If
           End If
       End If
colorok:
    Next
pasc:
Next
Application.ScreenUpdating = True
  Range("A1").Select
End Sub

Sub ki094a()
'最終セル
    
Sheets("Sheet1").Select
      ActiveCell.SpecialCells(xlLastCell).Select
      cend = ActiveCell.Row
      hisu = ActiveCell.Column
      Range(Cells(3, 8), Cells(cend, hisu)).Select
       Selection.Interior.ColorIndex = xlNone
        Range("A1").Select
End Sub