Как узнать, включен ли диапазон в другой диапазон с помощью VBA?


У меня есть проблема сравнения двух диапазонов. Для простоты я возьму два простых диапазона M6:M10 и M6:M8, я хочу знать, входит ли второй в первый, и первое, что я думаю, это написать

    Sub example()
    Dim range1, range2, inte As range
        Set range1 = range("M6:M10")
        Set range2 = range("M6:M8")
        Set intersec = Intersect(range1, range2)
        If intersec = range2 Then
            [if statement]
        End If
    End Sub

Но эта процедура возвращает мне следующую ошибку:

PRB: Error 13 (Type Mismatch) & Error 3061 w/ SQL Queries

Так что, возможно, я не могу использовать метод "intersect" таким образом...есть ли намек на то, как проверить включение полигона? Большое спасибо!

7 4

7 ответов:

Вот один из способов:

Sub ProperSubSet()
    Dim range1 As Range, range2 As Range, inte As Range
    Dim r As Range

    Set range1 = Range("M6:M10")
    Set range2 = Range("M6:M8")

    For Each r In range2
        If Intersect(r, range1) Is Nothing Then
            MsgBox "range2 is not a proper subset of range1"
        Exit Sub
        End If
    Next r
    MsgBox "range2 is a proper subset of range1"
End Sub

Сначала объявите переменные range1 и range2 как диапазоны.

Затем, когда вы сравниваете переменную intersec с переменной range2, используйте свойство address метода range для сравнения содержимого.

Что-то вроде:

Sub example()
Dim range1 As Range, range2 As Range, intersec As Range
    Set range1 = Range("M6:M10")
    Set range2 = Range("M11:M12")
    Set intersec = Intersect(range1, range2)
    If Not intersec Is Nothing Then
        If intersec.Address = range2.Address Then
            '[CODE GOES HERE]
        End If
    End If
End Sub

Я использую его следующим образом:

If Application.Intersect(rng1, rng2) Is Nothing Then 
    'herecomesthecode
Else
    'herecomesthecode
End if
Вы можете удалить else или написать Not nothing, в зависимости от того, чего вы хотите достичь.

Вот с чем можно поэкспериментировать:

Sub Test()
    Dim R1 As Range, R2 As Range, R3 As Range

    Set R1 = Application.InputBox("Select first range", , , , , , , 8)
    Set R2 = Application.InputBox("Select second range", , , , , , , 8)

    Set R3 = Intersect(R1, R2)
    If Not R3 Is Nothing Then
        If R3.Address = R1.Address Then
            MsgBox "First Range is subset of second"
        ElseIf R3.Address = R2.Address Then
            MsgBox "Second Range is subset of first"
        Else
            MsgBox "Neither range contained in the other"
        End If
    Else
        MsgBox "Ranges are disjoint"
    End If

End Sub

Еще один дополнительный вариант:

Sub ProperSubSet2()
    Dim range1 As Range, range2 As Range
    Set range1 = [M6:M10]
    Set range2 = [M6:M8]
    Set rComp = Intersect(range2, range1)

    If Not rComp Is Nothing Then
        If rComp.Cells.Count = range2.Cells.Count Then
            MsgBox "range2 is a proper subset of range1"
        Else
            MsgBox "range2 is not a proper subset of range1"
        End If
    Else
        MsgBox "Both ranges aren't intersected at all!"
    End If

End Sub

Вы можете сделать сравнение пересечения с диапазонами, чтобы выяснить, содержится ли один диапазон в другом. Какой-то код, чтобы показать это...

Sub TestExample()
    Dim Range1 As Range: Set Range1 = Range("M6:M10")
    Dim Range2 As Range: Set Range2 = Range("M6:M8")
    MsgBox Example(Range1, Range2)
End Sub

Function Example(Range1 As Range, Range2 As Range) As Integer
    Dim Overlay As Range: Set Overlay = Application.Intersect(Range1, Range2)
    If Not Overlay Is Nothing Then
        If Overlay.Address = Range1.Address Then Example = Example + 1
        If Overlay.Address = Range2.Address Then Example = Example + 2
    End If
End Function
Функция возвращает 0, если ни один диапазон не содержится полностью в другом, 1, если первый диапазон содержится во втором, 2, если второй диапазон содержится в первом и 3, Если диапазоны равны

Для более надежного решения, которое работает на диапазонах с несколькими областями, диапазонах на разных листах друг от друга, диапазонах с очень большим количеством ячеек (so .Графиня, нет .Граф), то это будет работать:

Function RangeContainsRange(BigRange As Range, SmallRange As Range) As Boolean
    If BigRange.Parent Is SmallRange.Parent Then
        RangeContainsRange = Application.Union(BigRange, SmallRange).Cells.CountLarge = BigRange.Cells.CountLarge
    Else
        RangeContainsRange = False
    End If
End Function