vba - 範囲内の交差しないアドレス

Question

私は2つの範囲A2:E2とを持っていますB1:B5。ここで、交差操作を実行すると、が返されますB2。B2いずれかの範囲で考慮されるようA2:E2に出力を取得できる方法が必要ですB1:B5。つまり、セルが繰り返されている場合は、避ける必要があります。

期待される出力：

A2,C2:E2,B1:B5

また

A2:E2,B1,B3:B5

誰かが私を助けることができますか？

Answer 1

このような？

Sub Sample()
    Dim Rng1 As Range, Rng2 As Range
    Dim aCell As Range, FinalRange As Range

    Set Rng1 = Range("A2:E2")
    Set Rng2 = Range("B1:B5")

    Set FinalRange = Rng1

    For Each aCell In Rng2
        If Intersect(aCell, Rng1) Is Nothing Then
            Set FinalRange = Union(FinalRange, aCell)
        End If
    Next

    If Not FinalRange Is Nothing Then Debug.Print FinalRange.Address
End Sub

出力:

$A$2:$E$2,$B$1,$B$3:$B$5

説明: ここで行っているのは、一時範囲を として宣言し、FinalRangeに設定することRange 1です。その後、各セルが にRange 2存在するかどうかを確認していRange 1ます。もしそうなら、私はそれを無視していUnionますRange 1

EDIT質問もここにクロス投稿されました

Answer 2

私の記事からUnion & Intersect と一緒に "Subtract Range" メソッドを追加する

このコードは、

• 2 番目の範囲から 1 つの範囲の交差を減算します。
• 2 つの別々の範囲の反対結合を返します (つまり、交差するセルのみを除外します)。

私はMappitでこのコードを使用しています! 非表示のセル (つまりHidden Cells = UsedRange - SpecialCells(xlVisible)) を識別します。

このコードは比較的長いですが、セル ループを回避して、より広い範囲で非常に高速になるように記述されています。

 Sub TestMe()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = [a2:e2]
Set rng2 = [b1:b5]
MsgBox RemoveIntersect(rng1, rng2) & " " & rng2.Address(0, 0)
End Sub

Function RemoveIntersect(ByRef rng1 As Range, ByRef rng2 As Range, Optional bBothRanges As Boolean) As String
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim rng3 As Range
    Dim lCalc As Long

    'disable screenupdating, event code and warning messages.
    'set calculation to Manual
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        lCalc = .Calculation
        .Calculation = xlCalculationManual
    End With

    'add a working WorkBook
    Set wb = Workbooks.Add(1)
    Set ws1 = wb.Sheets(1)

    On Error Resume Next
    ws1.Range(rng1.Address).Formula = "=NA()"
    ws1.Range(rng2.Address).Formula = vbNullString
    Set rng3 = ws1.Cells.SpecialCells(xlCellTypeFormulas, 16)
    If bBothRanges Then
        ws1.UsedRange.Cells.ClearContents
        ws1.Range(rng2.Address).Formula = "=NA()"
        ws1.Range(rng1.Address).Formula = vbNullString
        Set rng3 = Union(rng3, ws1.Cells.SpecialCells(xlCellTypeFormulas, 16))
    End If
    On Error GoTo 0
    If Not rng3 Is Nothing Then RemoveIntersect = rng3.Address(0, 0)

    'Close the working file
    wb.Close False
    'cleanup user interface and settings
    'reset calculation
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        lCalc = .Calculation
    End With

End Function