范围内的非相交地址



我有两个范围A2:E2B1:B5。现在,如果我执行交叉操作,它将返回我B2。我想要某种方式,通过这种方法,我可以在A2:E2B1:B5的任何一个范围内将我的输出作为B2考虑。即,如果有一个重复的单元格,则应避免使用。

预期输出 :

A2,C2:E2,B1:B5

A2:E2,B1,B3:B5

谁能帮我。

像这样?

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

编辑问题也交叉发布在这里

来自我的文章 在 Union & Intersect 旁边添加一个"减去范围"方法

此代码可用于

  • 从第二个范围减去一个范围的交集
  • 返回两个单独范围的反联合(即仅排除相互干扰的单元格)

我在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

最新更新