VBA Intersect Bereich in Bereich überprüfen statt Zelle in Bereich?

Hallo,

wie kann ich mit der Methode Application.Intersect zwei Bereiche miteinander Vergleichen?

Normalerweise kann ich ja z.b. mit :

If Not Application.Intersect(Target, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

Überprüfen ob eine Zelle in einem benannten Bereich ausgewählt oder sontiges ist.

Das klappt mit:

If Not Application.Intersect(Selection.Address, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

leider nur mittelmäßig.

Beispiel:

'''''''''''''''''''''''''''''''''''''1.
Set Bereich = Range("B1:B10")

'Ich markiere Zelle B1 bis B2 

If Not Application.Intersect(Selection.Address, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

'Ergebnis = Keine MsgBox - richtig

'''''''''''''''''''''''''''''''''''''2.
Set Bereich = Range("B1:B10")

'Ich markiere Zelle A1 bis A10  

If Not Application.Intersect(Selection.Address, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

'Ergebnis = MsgBox erscheint - richtig

'''''''''''''''''''''''''''''''''''''3.
Set Bereich = Range("B1:B10")

'Ich markiere Zelle A1 bis B1  

If Not Application.Intersect(Selection.Address, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

'Ergebnis = keine MsgBox - falsch, das soll nicht passieren

'''''''''''''''''''''''''''''''''''''4.
Set Bereich = Range("B1:B10")

'Ich markiere Zelle A1 bis C1  

If Not Application.Intersect(Selection.Address, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

'Ergebnis = keine MsgBox - falsch, das soll nicht passieren

'''''''''''''''''''''''''''''''''''''4.
Set Bereich = Range("B1:B10")

'Ich markiere Zelle B1 bis B15  

If Not Application.Intersect(Selection.Address, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

'Ergebnis = keine MsgBox - falsch, das soll nicht passieren

Wie schaff ich es, dass die MsgBox immer dann auftaucht, wenn mindestens eine Zelle nicht im Bereich ist?
Also der Markierte Bereich MUSS mit jeder Zelle im Definierten Bereich liegen.

Und eine Lösung ohne 'Split' oder Umwege wäre mir lieb, außer es gibt halt keine andere xD

Answer 1

[DanKirpan]

Hallo,

das Problem scheint hier darin zu liegen das Intersect nie leer sein wird solange es mindestens eine Überschneidung der Bereiche gibt, was allerdings keinen Rückschluss auf einen evtl "Überschuss" zulässt. Um einen Überschuss festzustellen, müsste man jede Zelle im selektierten Bereich einzeln betrachten

Sub Bereichvergleich()
Dim Bereich As Range
Dim zelle As Range
Dim Ergebnis As Boolean

Set Bereich = Range("B1:B10")
Ergebnis = False

For Each zelle In Selection
    If Application.Intersect(zelle, Bereich) Is Nothing Then
        Ergebnis = True
        Exit For
    End If
Next zelle

If Ergebnis Then
    MsgBox "Nicht innerhalb"
End If

End Sub

Answer 2

[Hannes62a]

Einfacher geht es, wenn Du prüfst, ob der Intersect Bereich gleich ist mit dem markierten Bereich. Hier mal ein Ansatz dafür:

Sub test()
Dim RangeA As Range
Dim RangeB As Range

Set RangeA = Range("B1:B10")

Set RangeB = Range("B1:B2")
Debug.Print Intersect(RangeA, RangeB).Address = RangeB.Address
' liefert WAHR

Set RangeB = Range("A1:B2")
Debug.Print Intersect(RangeA, RangeB).Address = RangeB.Address
'liefert FALSCH
End Sub

Hilft Dir das?