Excel VBA質問箱 IV

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

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


45010 / 76732 ←次へ | 前へ→

【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

4 hits

【36725】複数の長方形における干渉をチェックするマクロについて しとうと 06/4/10(月) 22:55 質問
【36728】Re:複数の長方形における干渉をチェックす... ちくたく 06/4/11(火) 10:22 発言
【36729】Re:複数の長方形における干渉をチェックす... しろうと 06/4/11(火) 10:51 発言
【36731】Re:複数の長方形における干渉をチェック... わいわい 06/4/11(火) 11:33 発言
【36733】Re:複数の長方形における干渉をチェック... ちくたく 06/4/11(火) 11:57 発言
【36738】Re:複数の長方形における干渉をチェック... ハト 06/4/11(火) 16:01 発言
【36739】Re:複数の長方形における干渉をチェック... ちくたく 06/4/11(火) 16:31 発言
【36740】Re:複数の長方形における干渉をチェック... ハト 06/4/11(火) 17:05 発言
【36747】Re:複数の長方形における干渉をチェック... ハト 06/4/12(水) 8:09 発言
【36741】Re:複数の長方形における干渉をチェック... こたつねこ 06/4/11(火) 17:41 発言
【36742】Re:複数の長方形における干渉をチェック... ハト 06/4/11(火) 18:06 発言
【36744】Re:複数の長方形における干渉をチェック... こたつねこ 06/4/11(火) 18:30 発言
【36736】Re:複数の長方形における干渉をチェックす... こたつねこ 06/4/11(火) 15:13 回答
【36745】Re:複数の長方形における干渉をチェックす... ichinose 06/4/11(火) 21:42 発言
【36746】Re:複数の長方形における干渉をチェックす... 平塚在住 06/4/11(火) 22:37 回答

45010 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free