|
皆さん、こんばんは。
作業列を使用した方法です。
'================================================
Sub main()
Const sagyo = 10 'この例ではO列を作業列に使っています
Dim rng As Range
Dim arng As Range
Set rng = Range(Cells(17, "e"), Cells(Rows.Count, "e").End(xlUp))
rng.Interior.ColorIndex = xlNone
If rng.Row >= 17 And rng.Count > 1 Then
On Error Resume Next
Names("rec").Delete
Names.Add "rec", rng
With rng
With .Offset(0, sagyo)
.Formula = _
"=IF(D17=1," & _
"if(SUMPRODUCT(" & _
"(ABS(OFFSET(rec,0,1)-F17)<=(OFFSET(rec,0,4)+I17)/2)*" & _
"(ABS(OFFSET(rec,0,2)-G17)<=(OFFSET(rec,0,5)+J17)/2))>1,1,""""),"""")"
Err.Clear
Set arng = .SpecialCells(xlCellTypeFormulas, xlNumbers)
If Err.Number = 0 Then
arng.Cells(1).Offset(0, -sagyo).Interior.ColorIndex = 6
End If
.Formula = ""
End With
End With
Names("rec").Delete
End If
End Sub
これとは別に、数式と条件付書式を使用してもちょっと仕様が違いますが、
できそうですよ!!
試してみて下さい。
|
|