範圍內的不相交地址

Question

我有兩個範圍A2:E2和B1:B5。現在如果我執行相交操作，它將返回我B2。我想通過某種方式，我可以在的任何一個範圍內考慮我的輸出A2:E2和B1:B5。即如果存在重複的細胞，則應該避免。

預期輸出：

A2,C2:E2,B1:B5

OR

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

編輯問題也是交叉貼here

Answer 2

從我的文章Adding a "Subtract Range" method alongside Union & Intersect

該代碼可以用來

• 從第二範圍減去一個範圍的相交點
• 返回兩個獨立的範圍內的反工會（即僅排除細胞intersetc）

我用Mappit!這個代碼indentify隱藏的單元格（即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