Excel - тест для перекрывающихся регионов

Question

У меня есть электронная таблица, в которой есть диаграмма для нескольких различных объектов, в которой указано расположение их левого, правого, верхнего и нижнего краев относительно точки в левом верхнем углу. Я хочу сделать условие для форматирования ячейки, содержащей объект, как красный, когда одна из областей, которые он создает, перекрывает любую из других областей.Например, если:

......................Объект 1:............Объект 2............Объект 3:
Левый край: ........... 2 ........................ 0 ....................... 3
Правый край: ......... 6 ......................... 2 ........... ............ 8
Верх: .................... 1 ........................ 10 .. .................... 8
Внизу: ............... 6 ....................... 12 ........ ............. 8

Тогда Объект 1 и Объект 3 загорятся красным, так как они перекрываются, но Объект 2 останется неосвещенным, поскольку он нигде больше не перекрывается. Я создал программу, которая успешно делает это, используя ИЛИ длинный список операторов И (три оператора И для каждого края каждого объекта) для каждого Объекта, но это очень грязно, отнимает много времени, подвержено ошибкам и совершенно нецелесообразно для более чем 4 предметов. Есть ли способ лучше? Если бы кто-нибудь мог мне помочь, я был бы очень признателен.

Answer 1

Что-то еще, чтобы рассмотреть:

Sub DetectOverlaps()
  Const OBJECTCOUNT As Long = 3
  Dim i As Long, j As Long
  Dim ArrObj1 As Variant, ArrObj2 As Variant
  Dim Object1 As Range, Object2 As Range
  Debug.Print: Debug.Print
  For i = 1 To OBJECTCOUNT - 1
    j = i + 1
    While j <= OBJECTCOUNT
      ArrObj1 = Range("A1").Offset(1, i).Resize(4, 1)
      ArrObj2 = Range("A1").Offset(1, j).Resize(4, 1)
      Set Object1 = CoordinatesToRange(ArrObj1)
      Set Object2 = CoordinatesToRange(ArrObj2)

      Debug.Print "checking " & i & "-" & j, Object1.Address & " vs. " & Object2.Address,
      If Application.Intersect(Object1, Object2) Is Nothing Then
        Debug.Print "  -->ok"
      Else
        Debug.Print "  -->COLLISION"
      End If
      j = j + 1
    Wend
  Next i
End Sub

Function CoordinatesToRange(RangeAsArray As Variant) As Range
' RangeAsArray contains coordinates, in order: left, right, top, bottom
  Set CoordinatesToRange = Cells(RangeAsArray(3, 1) + 1, RangeAsArray(1, 1) + 1).Resize(RangeAsArray(4, 1) - RangeAsArray(3, 1) + 1, RangeAsArray(2, 1) - RangeAsArray(1, 1) + 1)
End Function

Это использует Application.Intersect чтобы обнаружить перекрывающиеся диапазоны (которые построены из прямоугольных координат). Диапазоны здесь не имеют особого смысла, но пока координаты находятся между 0 и максимально допустимой строкой / столбцом в вашей версии Excel, это будет сообщать о наличии столкновения между любыми двумя парами диапазонов.

Я предположил, что ваше определение "Объекты" основано на A1 и имеет одну строку и один заголовок столбца. Константа вверху - просто дешевый код для указания количества интересующих объектов; Вы можете варьировать, чтобы удовлетворить или, возможно, сделать это динамичным в вашем приложении.

Answer 2

Макрос VBA может делать то, что вы ищете. В Windows Alt+F11 вызовет редактор VBA.

Общий псевдокод, который должен следовать:

• с выбором захватить первый ряд
• очистить от него формат выделения
• используйте For Each чтобы пройти горизонтально по нему
• с каждым объектом сохраните значения для 4-х ячеек под ним в именованных переменных
• затем во внутреннем цикле сравните эти значения со всеми объектами справа
• сравнение будет логичным, а вместе тесты горизонтального и вертикального перекрытия
• пометьте обе ячейки, если есть совпадение

Используя этот метод, если у вас есть 10 полей, вы отмечаете 45 пар, а не 100 (10 * 10)