范围内的不相交地址

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