非交差範囲VBA

Question

rngIntersect.AddressはA10を返します。ループすることなく交差点を除いてすべての範囲を取得できる方法はありますか？私の知る限り、このための「クリーン」機能がありません知っているように

おかげ

Sub NotIntersect() 

    Dim rng As Range, rngVal As Range, rngIntersect As Range 
    Set rng = Range("A1:A10") 
    Set rngVal = Range("A10") 

    Set rngIntersect = Intersect(rng, rngVal) 
    MsgBox rngIntersect.Address 

End Sub 

Answer 1

私はこの質問を投稿されましたが、回答が不足しているため、必要な解決策を得ました。私はコードをテストし、正常に動作します。私はそれが助けて欲しい

msdnの投稿にはlinkがあります。

Sub NotIntersect() 
     Dim rng As Range, rngVal As Range, rngDiff As Range 
     Set rng = Range("A1:A10") 
     Set rngVal = Range("A5") 
     Set rngDiff = Difference(rng, rngVal) 
     MsgBox rngDiff.Address 
    End Sub 

    Function Difference(Range1 As Range, Range2 As Range) As Range 
     Dim rngUnion As Range 
     Dim rngIntersect As Range 
     Dim varFormulas As Variant 
     If Range1 Is Nothing Then 
      Set Difference = Range2 
     ElseIf Range1 Is Nothing Then 
      Set Difference = Range1 
     Else 
      Set rngUnion = Union(Range1, Range2) 
      Set rngIntersect = Intersect(Range1, Range2) 
      If rngIntersect Is Nothing Then 
       Set Difference = rngUnion 
      Else 
       varFormulas = rngUnion.Formula 
       rngUnion.Value = 0 
       rngIntersect.ClearContents 
       Set Difference = rngUnion.SpecialCells(xlCellTypeConstants) 
       rngUnion.Formula = varFormulas 
      End If 
     End If 
    End Function 

Answer 2

。要件「いいえループは、」重要な場合は、次のことを試みることができる（これは、コードを動作していない、「アプローチ」である）：

- create a new sheet 
- find intersection of ranges 
- set range from top left to bottom right of intersection to 0 
- set range1 to 1 
- set all values in range2 = XOR of values that are there (so 1 becomes 0, and 0 becomes 1) 
- find all cells with a 1 - their address is the "non-intersection" 
- delete the temp sheet 

私はこれらのそれぞれがループせずに行うことができると信じて - それはです恐ろしいハック...

Answer 3

あなたが探しているのは、セット理論の用語の「補体」です。 Wikipediaを参照してください。このは、両方の範囲内のすべてのセルをループせずに実行できますが（セルが多い範囲ではオーバーヘッドが大きくなります）、範囲内の各領域をループする必要があります。そのループは迅速かつ効率的です。ここで、コードは次のとおりです。次のように

Public Function NotIntersect(Range1 As Range, Range2 As Range) As Range 
Dim NewRange As Range, CurrentArea As Range, CurrentNewArea(1 To 4) As Range, r As Range 
Dim c%, a% 
Dim TopLeftCell(1 To 2) As Range, BottomRightCell(1 To 2) As Range 
Dim NewRanges() As Range, ColNewRanges() As New Collection 
Const N% = 2 
Const U% = 1 

If Range1 Is Nothing And Range2 Is Nothing Then 
    Set NotIntersect = Nothing 
ElseIf Range1.Address = Range2.Address Then 
    Set NotIntersect = Nothing 
ElseIf Range1 Is Nothing Then 
    Set NotIntersect = Range2 
ElseIf Range1 Is Nothing Then 
    Set NotIntersect = Range1 
Else 

    Set TopLeftCell(U) = Range1.Cells(1, 1) 
    Set BottomRightCell(U) = Range1.Cells(Range1.Rows.Count, Range1.Columns.Count) 

    c = Range2.Areas.Count 
    ReDim ColNewRanges(1 To c) 
    ReDim NewRanges(1 To c) 

    For a = 1 To c 
     Set CurrentArea = Range2.Areas(a) 
     Set TopLeftCell(N) = CurrentArea.Cells(1, 1) 
     Set BottomRightCell(N) = CurrentArea.Cells(CurrentArea.Rows.Count, CurrentArea.Columns.Count) 

     On Error Resume Next 
     Set ColNewRanges(a) = New Collection 
     ColNewRanges(a).Add Range(TopLeftCell(U), Cells(TopLeftCell(N).Row - 1, BottomRightCell(U).Column)) 
     ColNewRanges(a).Add Range(Cells(TopLeftCell(N).Row, TopLeftCell(U).Column), Cells(BottomRightCell(N).Row, TopLeftCell(N).Column - 1)) 
     ColNewRanges(a).Add Range(Cells(TopLeftCell(N).Row, BottomRightCell(N).Column + 1), Cells(BottomRightCell(N).Row, BottomRightCell(U).Column)) 
     ColNewRanges(a).Add Range(Cells(BottomRightCell(N).Row + 1, TopLeftCell(U).Column), BottomRightCell(U)) 
     On Error GoTo 0 

     For Each r In ColNewRanges(a) 
      If NewRanges(a) Is Nothing Then 
       Set NewRanges(a) = r 
      Else 
       Set NewRanges(a) = Union(NewRanges(a), r) 
      End If 
     Next r 

    Next a 

    For a = 1 To c 
     If NewRange Is Nothing Then 
      Set NewRange = NewRanges(a) 
     Else 
      Set NewRange = Intersect(NewRange, NewRanges(a)) 
     End If 
    Next a 

    Set NotIntersect = Intersect(Range1, NewRange) 'intersect required in case it's on the bottom or right line, so a part of range will go beyond the line... 

End If  
End Function 

テストは以下のとおりです。

Sub Test1() 
    NotIntersect(Range("$A$1:$N$24"), Range("$G$3:$H$12,$C$4:$D$7,$A$13:$A$15")).Select 
End Sub