Excel VBA質問箱 IV

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

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


45003 / 76732 ←次へ | 前へ→

【36736】Re:複数の長方形における干渉をチェックするマクロについて
回答  こたつねこ  - 06/4/11(火) 15:13 -

引用なし
パスワード
   みなさん、こんにちは

しとうとさんの参考になればいいのですが・・・
細かな仕様を把握していませんので、動作が違う場合は
ご指摘ください。


'--構造体定義 STR--
Type BoxInfo    '四角形の構造体情報
  CX As Double  '中心座標X
  CY As Double  '中心座標Y
  XX As Double  '長さX
  YY As Double  '長さY
End Type
'--構造体定義 END--

Sub Check_contact()
  Dim box1 As BoxInfo
  Dim box2 As BoxInfo
  Dim N As Integer
  Dim M As Integer
  
  For N = 17 To 65
    If Cells(N, 5).Value = 1 Then
      '--四角形情報を関連セルより取得 STR--
      With box1
        .CX = Cells(N, 6).Value
        .CY = Cells(N, 7).Value
        .XX = Cells(N, 8).Value
        .YY = Cells(N, 9).Value
      End With
      '--四角形情報を関連セルより取得 END--
      
      For M = N + 1 To 66
        If Cells(M, 5).Value = 1 Then
          '--四角形情報を関連セルより取得 STR--
          With box2
            .CX = Cells(M, 6).Value
            .CY = Cells(M, 7).Value
            .XX = Cells(M, 8).Value
            .YY = Cells(M, 9).Value
          End With
          '--四角形情報を関連セルより取得 END--
          
          '2つの四角形が重なり合うか?
          If intervention(box1, box2) Then
            '--重なる場合はセルに色づけ STR--
            With Cells(N, 5).Interior
              .ColorIndex = 36
              .Pattern = xlSolid
            End With
            
            With Cells(M, 5).Interior
              .ColorIndex = 36
              .Pattern = xlSolid
            End With
            '--重なる場合はセルに色づけ END--
          End If
        End If
      Next
    End If
  Next
End Sub

'------------------------------------
'■2つの四角形が重なるか判定する関数
'引数1:box1
'引数2:box2
'戻り値:True =重なる
'   :Flase=重ならない
'------------------------------------
Function intervention(ByRef box1 As BoxInfo, ByRef box2 As BoxInfo) As Boolean
  '--比較元用座標情報格納用変数 STR--
  Dim bx1 As Double
  Dim bx2 As Double
  Dim by1 As Double
  Dim by2 As Double
  '--比較元用座標情報格納用変数 END--
  
  '--比較先用座標情報格納用変数 STR--
  Dim cx1 As Double
  Dim cx2 As Double
  Dim cy1 As Double
  Dim cy2 As Double
  '--比較先用座標情報格納用変数 END--
  
  'X軸方向に長い値を比較元に
  '     短い値を比較先にセット
  If box1.XX > box2.XX Then
    Call setX(box1, bx1, bx2)
    Call setX(box2, cx1, cx2)
  Else
    Call setX(box2, bx1, bx2)
    Call setX(box1, cx1, cx2)
  End If
  
  '比較元のX軸座標の範囲に比較先のX軸座標が含まれているか計算
  intervention = (bx1 <= cx1 And cx1 <= bx2) Or (bx1 <= cx2 And cx2 <= bx2)
  
  '含まれていないので処理を抜ける
  If intervention = False Then Exit Function
  
  'Y軸方向に長い値を比較元に
  '     短い値を比較先にセット
  If box1.YY > box2.YY Then
    Call setY(box1, by1, by2)
    Call setY(box2, cy1, cy2)
  Else
    Call setY(box2, by1, by2)
    Call setY(box1, cy1, cy2)
  End If
  
  '比較元のY軸座標の範囲に比較先のY軸座標が含まれているか計算
  intervention = (by1 <= cy1 And cy1 <= by2) Or (by1 <= cy2 And cy2 <= by2)
End Function

'------------------------
'■X座標をセットする処理
'------------------------
Sub setX(ByRef typebox As BoxInfo, x1 As Double, x2 As Double)
  With typebox
    x1 = .CX - .XX / 2
    x2 = .CX + .XX / 2
  End With
End Sub

'------------------------
'■Y座標をセットする処理
'------------------------
Sub setY(ByRef typebox As BoxInfo, y1 As Double, y2 As Double)
  With typebox
    y1 = .CY - .YY / 2
    y2 = .CY + .YY / 2
  End With
End Sub
10 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 回答

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