| 
    
     |  | ▼ichinose さん: ありがとうございます。
 一様自分なりに修正してみました。
 結果もいい感じなのですが
 間違いないでしょうかチョット自信がありません
 確認宜しくお願いします。
 '============================================================
 Option Explicit
 '============================================================
 Sub main()
 Dim rng As Range
 Dim g0 As Long
 Dim g1 As Long
 Dim c_array As Variant
 Dim st1 As Long, ed1 As Long
 Dim ret As Boolean
 
 Set rng = Range("A3", Cells(Rows.Count, 6).End(xlUp))
 rng.Interior.ColorIndex = xlNone
 
 'Cells.Interior.ColorIndex = xlNone★項目行色設定のため上記コードに変更
 Set rng = Range("b3", Cells(Rows.Count, 2).End(xlUp))
 If rng.Row > 1 Then
 init_ovl_chk_tbl
 For g0 = 1 To rng.Count
 c_array = get_ovl_chk_tbl(rng(g0, 1).Value)
 If TypeName(c_array) = "Boolean" Then
 Call add_ovl_chk_tbl(rng(g0, 1).Value, CLng(rng(g0, 3).Value), _
 CLng(rng(g0, 4).Value), rng(g0, 5).Value, _
 rng(g0, 6).Value)
 Else
 st1 = CLng(rng(g0, 3).Value)
 ed1 = CLng(rng(g0, 4).Value)
 ret = True
 For g1 = LBound(c_array) To UBound(c_array) Step 4
 If chk_ovl(st1, ed1, c_array(g1), c_array(g1 + 1)) Then
 rng(g0).Resize(, 6).Interior.ColorIndex = 35
 If rng(g0, 5).Value = c_array(g1 + 2) And _
 rng(g0, 6).Value = c_array(g1 + 3) Then
 rng(g0).Resize(, 6).Interior.ColorIndex = 6
 End If
 ret = False
 Exit For
 End If
 Next g1
 If ret = True Then
 Call add_ovl_chk_tbl(rng(g0, 1).Value, st1, ed1, _
 rng(g0, 5).Value, rng(g0, 6).Value)
 End If
 End If
 Next g0
 term_ovl_chk_tbl
 End If
 
 End Sub
 
 |  |