|
▼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
|
|