Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

45013 / 76735

←次へ　｜　前へ→


	【36729】Re:複数の長方形における干渉をチェックするマクロについて

しろうと - 06/4/11(火) 10:51 -


	引用なし

	パスワード

ちくたくさんへ

ご回答ありがとうございます。

>AutoCADをもってらっしゃいませんか？

残念ながら，AutoCADは持っておりません。

自分でも考えてみたのですが，うまく機能致しません。

以下に記載させて頂きます。

もし，訂正箇所がございましたら，ご指摘いただけると幸いです。

以上，よろしくお願い致します。

Sub Check_contact()

Dim N, M, ans As Integer
Dim AminX, AmaxX, AminY, AmaxY, BminX, BmaxX, BminY, BmaxY As Single
Dim msglist(0) As String

　　msglist(0) = "長方形同士が接触している可能性があります。" & vbCrLf & vbCrLf & _
　　　　　　　　 "該当長方形の名称のセル背景は黄色で表示されています。 " & vbCrLf & vbCrLf & _
　　　　　　　　 "該当長方形の[中心座標]および[サイズ] の数値を" & vbCrLf & _
　　　　　　　　 "再チェックし，正しい数値を入力してください。"

'A:元の長方形,B:比較対象の長方形
　　
For N = 17 To 65
If Cells(N, 4) = 1 Then 'if1
　For M = N + 1 To 66
　　If Cells(M, 4) = 1 Then 'if2
　　
　　 AminX = Cells(N, 6).value - Cells(N, 9).value / 2
　　 AmaxX = Cells(N, 6).value + Cells(N, 9).value / 2
　　 BminX = Cells(M, 6).value - Cells(M, 9).value / 2
　　 BmaxX = Cells(M, 6).value + Cells(M, 9).value / 2

　　 AminY = Cells(N, 7).value - Cells(N, 10).value / 2
　　 AmaxY = Cells(N, 7).value + Cells(N, 10).value / 2
　　 BminY = Cells(M, 7).value - Cells(M, 10).value / 2
　　 BmaxY = Cells(M, 7).value + Cells(M, 10).value / 2

　　 If AminX <= BminX <= AmaxX Then 'if3
　　　
　　　　 If AminY <= BminY <= AmaxY Then 'if4
　　　
　　　　　 Cells(N, 5).Select
　　　　　　 With Selection.Interior
　　　　　　 .ColorIndex = 36
　　　　　　 .Pattern = xlSolid
　　　　　 End With
　　　　　 Cells(M, 5).Select
　　　　　　 With Selection.Interior
　　　　　　 .ColorIndex = 36
　　　　　　 .Pattern = xlSolid
　　　　　 End With
　　　
　　　　　ans = MsgBox(msglist(0), 65552, "パラメータ設定エラー")
　　　　　End
　　　　
　　　　 ElseIf AminY <= BmaxY <= AmaxY Then 'if4
　　　
　　　　　 Cells(N, 5).Select
　　　　　　 With Selection.Interior
　　　　　　 .ColorIndex = 36
　　　　　　 .Pattern = xlSolid
　　　　　 End With
　　　　　 Cells(M, 5).Select
　　　　　　 With Selection.Interior
　　　　　　 .ColorIndex = 36
　　　　　　 .Pattern = xlSolid
　　　　　 End With
　　　
　　　　　ans = MsgBox(msglist(0), 65552, "パラメータ設定エラー")
　　　　　End
　　　　　
　　　　 End If 'if4
　　
　　 End If 'if3
　　
　　 If AminX <= BmaxX <= AmaxX Then 'if5
　　　
　　　 If AminY <= BminY <= AmaxY Then 'if6
　　　
　　　　　 Cells(N, 5).Select
　　　　　　 With Selection.Interior
　　　　　　 .ColorIndex = 36
　　　　　　 .Pattern = xlSolid
　　　　　 End With
　　　　　 Cells(M, 5).Select
　　　　　　 With Selection.Interior
　　　　　　 .ColorIndex = 36
　　　　　　 .Pattern = xlSolid
　　　　　 End With
　　　
　　　　　ans = MsgBox(msglist(0), 65552, "パラメータ設定エラー")
　　　　　End
　　　　
　　　 ElseIf AminY <= BmaxY <= AmaxY Then 'if6
　　　
　　　　　 Cells(N, 5).Select
　　　　　　 With Selection.Interior
　　　　　　 .ColorIndex = 36
　　　　　　 .Pattern = xlSolid
　　　　　 End With
　　　　　 Cells(M, 5).Select
　　　　　　 With Selection.Interior
　　　　　　 .ColorIndex = 36
　　　　　　 .Pattern = xlSolid
　　　　　 End With
　　　
　　　　　ans = MsgBox(msglist(0), 65552, "パラメータ設定エラー")
　　　　　End
　　　　　
　　　 End If 'if6
　　　
　　 End If 'if5
　　
　　End If 'if2
　Next M
End If 'if1
Next N

End Sub

0 hits

▼

【36725】複数の長方形における干渉をチェックするマクロについて しとうと 06/4/10(月) 22:55