| |
しろうと さん 、わいわい さん
こんにちは。
コードにしてみたんですけど、
正直、合ってるのか間違ってるのかわからないので、
検証をお願いします。
コメント入れてるので、なんとかわかって頂けたらと思います。
これが合ってたら、処理の速さは考えなければ、
ループを回すだけなんですけどね。
Sub test()
Dim rectA(1 To 4) As Double, rectB(1 To 4) As Double
Dim i As Integer, f As Boolean
i = 17
f = False
'rectA、rectBを四角形とし、それぞれの上下左右の座標値を格納
rectA(1) = Range("F" & i) + Range("I" & i) / 2 '右
rectA(2) = Range("F" & i) - Range("I" & i) / 2 '左
rectA(3) = Range("G" & i) + Range("J" & i) / 2 '上
rectA(4) = Range("G" & i) - Range("J" & i) / 2 '下
i = i + 1
rectB(1) = Range("F" & i) + Range("I" & i) / 2 '右
rectB(2) = Range("F" & i) - Range("I" & i) / 2 '左
rectB(3) = Range("G" & i) + Range("J" & i) / 2 '上
rectB(4) = Range("G" & i) - Range("J" & i) / 2 '下
'rectAに対するrectBの位置を検査
'きれいなコードではないけれど、If文でひとつずつ精査していくこととする。
'まずは、rectAに対し、上が含まれる可能性があるか。
'rectBの上がrectAの上よりも下であり、かつ、rectAの下よりも上であること
If rectB(3) <= rectA(3) And rectB(3) >= rectA(4) Then
f = True
End If
'次に、rectAに対し、下が含まれる可能性があるか。
'rectBの下がrectAの下よりも上であり、かつ、rectAの上よりも下であること
If rectB(4) <= rectA(4) And rectB(4) >= rectA(3) Then
f = True
End If
'フラグに引っかかってたら、横についての検査。
If f = True Then
'まずは、rectAに対し、左が含まれる可能性があるか。
'rectBの左がrectAの左よりも右であり、かつ、rectAの右よりも左であること。
If rectB(2) >= rectA(2) And rectB(2) <= rectA(1) Then
MsgBox ("交差しています")
End If
'次に、rectAに対し、右が含まれる可能性があるか。
'rectBの右がrectAの右よりも左であり、かつ、rectAの左よりも右であること。
If rectB(1) <= rectA(1) And rectB(1) >= rectA(2) Then
MsgBox ("交差しています")
End If
End If
End Sub
|
|
ちくたく
- 06/4/11(火) 11:57 -
